home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / eval.c < prev    next >
Text File  |  1993-10-23  |  73KB  |  2,791 lines
  1. /* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    eval.c,v $
  9.  * Revision 4.0.1.4  92/06/08  13:20:20  lwall
  10.  * patch20: added explicit time_t support
  11.  * patch20: fixed confusion between a *var's real name and its effective name
  12.  * patch20: added Atari ST portability
  13.  * patch20: new warning for use of x with non-numeric right operand
  14.  * patch20: modulus with highest bit in left operand set didn't always work
  15.  * patch20: dbmclose(%array) didn't work
  16.  * patch20: added ... as variant on ..
  17.  * patch20: O_PIPE conflicted with Atari
  18.  * 
  19.  * Revision 4.0.1.3  91/11/05  17:15:21  lwall
  20.  * patch11: prepared for ctype implementations that don't define isascii()
  21.  * patch11: various portability fixes
  22.  * patch11: added sort {} LIST
  23.  * patch11: added eval {}
  24.  * patch11: sysread() in socket was substituting recv()
  25.  * patch11: a last statement outside any block caused occasional core dumps
  26.  * patch11: missing arguments caused core dump in -D8 code
  27.  * patch11: eval 'stuff' now optimized to eval {stuff}
  28.  * 
  29.  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  30.  * patch4: new copyright notice
  31.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  32.  * patch4: assignment wasn't correctly de-tainting the assigned variable.
  33.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  34.  * patch4: added $^P variable to control calling of perldb routines
  35.  * patch4: taintchecks could improperly modify parent in vfork()
  36.  * patch4: many, many itty-bitty portability fixes
  37.  * 
  38.  * Revision 4.0.1.1  91/04/11  17:43:48  lwall
  39.  * patch1: fixed failed fork to return undef as documented
  40.  * patch1: reduced maximum branch distance in eval.c
  41.  * 
  42.  * Revision 4.0  91/03/20  01:16:48  lwall
  43.  * 4.0 baseline.
  44.  * 
  45.  */
  46.  
  47. #include "EXTERN.h"
  48. #include "perl.h"
  49.  
  50. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  51. #include <signal.h>
  52. #endif
  53.  
  54. #ifdef I_FCNTL
  55. #include <fcntl.h>
  56. #endif
  57. #ifdef MSDOS
  58. /* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
  59.    but fcntl.h is required for O_BINARY */
  60. #include <fcntl.h>
  61. #endif
  62. #ifdef I_SYS_FILE
  63. #include <sys/file.h>
  64. #endif
  65. #ifdef I_VFORK
  66. #   include <vfork.h>
  67. #endif
  68.  
  69. #ifdef VOIDSIG
  70. static void (*ihand)();
  71. static void (*qhand)();
  72. #else
  73. static int (*ihand)();
  74. static int (*qhand)();
  75. #endif
  76.  
  77. ARG *debarg;
  78. STR str_args;
  79. static STAB *stab2;
  80. static STIO *stio;
  81. static struct lstring *lstr;
  82. static int old_rschar;
  83. static int old_rslen;
  84.  
  85. char *getlogin();
  86.  
  87. #include <Math.h>
  88.  
  89. #define SMALLSWITCHES
  90.  
  91. typedef enum {
  92.     R_nojump,
  93.     R_array_return,
  94.     R_say_no,
  95.     R_re_eval,
  96.     R_badsock,
  97.     R_say_yes,
  98.     R_say_undef,
  99.     R_donumset,
  100.     R_say_zero} EvalResult;
  101.  
  102. typedef struct {
  103.     ARG *        arg;
  104.     int         gimme;
  105.     int         sp;
  106.     STR *        str;
  107.     int         anum;
  108.     int         optype;
  109.     STR **        st;
  110.     int         maxarg;
  111.     double         value;
  112.     char *        tmps;
  113.     char *        tmps2;
  114.     int         argflags;
  115.     int         argtype;
  116.     union argptr     argptr;
  117.     int         arglast[8];    /* highest ed->sp for arg--valid only for non-O_LIST args */
  118.     unsigned long     tmpulong;
  119.     long         tmplong;
  120.     long        longo;
  121.     time_t         when;
  122.     STRLEN        tmplen;
  123.     FILE *        fp;
  124.     STR *        tmpstr;
  125.     FCMD *        form;
  126.     STAB *        stab;
  127.     ARRAY *        ary;
  128.     bool         assigning;
  129. } EvalData;
  130.  
  131. char *crypt(), *getenv();
  132. extern void grow_dlevel();
  133.  
  134. EvalResult eval1(EvalData * ed)
  135. {
  136.     switch (ed->optype) {
  137.     case O_RCAT:
  138.     STABSET(ed->str);
  139.     break;
  140.     case O_ITEM:
  141.     if (ed->gimme == G_ARRAY)
  142.         goto array_return;
  143.     /* FALL THROUGH */
  144.     case O_SCALAR:
  145.     STR_SSET(ed->str,ed->st[1]);
  146.     STABSET(ed->str);
  147.     break;
  148.     case O_ITEM2:
  149.     if (ed->gimme == G_ARRAY)
  150.         goto array_return;
  151.     --ed->anum;
  152.     STR_SSET(ed->str,ed->st[ed->arglast[ed->anum]-ed->arglast[0]]);
  153.     STABSET(ed->str);
  154.     break;
  155.     case O_ITEM3:
  156.     if (ed->gimme == G_ARRAY)
  157.     goto array_return;
  158.     --ed->anum;
  159.     STR_SSET(ed->str,ed->st[ed->arglast[ed->anum]-ed->arglast[0]]);
  160.     STABSET(ed->str);
  161.     break;
  162.     case O_CONCAT:
  163.     STR_SSET(ed->str,ed->st[1]);
  164.     str_scat(ed->str,ed->st[2]);
  165.     STABSET(ed->str);
  166.     break;
  167.     case O_REPEAT:
  168.     if (ed->gimme == G_ARRAY && ed->arg[1].arg_flags & AF_ARYOK) {
  169.         ed->sp = do_repeatary(ed->arglast);
  170.         goto array_return;
  171.     }
  172.     STR_SSET(ed->str,ed->st[1]);
  173.     ed->anum = (int)str_gnum(ed->st[2]);
  174.     if (ed->anum >= 1) {
  175.         ed->tmpstr = Str_new(50, 0);
  176.         ed->tmps = str_get(ed->str);
  177.         str_nset(ed->tmpstr,ed->tmps,ed->str->str_cur);
  178.         ed->tmps = str_get(ed->tmpstr);    /* force to be string */
  179.         STR_GROW(ed->str, (ed->anum * ed->str->str_cur) + 1);
  180.         repeatcpy(ed->str->str_ptr, ed->tmps, ed->tmpstr->str_cur, ed->anum);
  181.         ed->str->str_cur *= ed->anum;
  182.         ed->str->str_ptr[ed->str->str_cur] = '\0';
  183.         ed->str->str_nok = 0;
  184.         str_free(ed->tmpstr);
  185.     }
  186.     else {
  187.         if (dowarn && ed->st[2]->str_pok && !looks_like_number(ed->st[2]))
  188.             warn("Right operand of x is not numeric");
  189.         str_sset(ed->str,&str_no);
  190.     }
  191.     STABSET(ed->str);
  192.     break;
  193.     case O_MATCH:
  194.     ed->sp = do_match(ed->str,ed->arg,
  195.       ed->gimme,ed->arglast);
  196.     if (ed->gimme == G_ARRAY)
  197.         goto array_return;
  198.     STABSET(ed->str);
  199.     break;
  200.     case O_NMATCH:
  201.     ed->sp = do_match(ed->str,ed->arg,
  202.       G_SCALAR,ed->arglast);
  203.     str_sset(ed->str, str_true(ed->str) ? &str_no : &str_yes);
  204.     STABSET(ed->str);
  205.     break;
  206.     case O_SUBST:
  207.     ed->sp = do_subst(ed->str,ed->arg,ed->arglast[0]);
  208.     goto array_return;
  209.     case O_NSUBST:
  210.     ed->sp = do_subst(ed->str,ed->arg,ed->arglast[0]);
  211.     ed->str = ed->arg->arg_ptr.arg_str;
  212.     str_set(ed->str, str_true(ed->str) ? No : Yes);
  213.     goto array_return;
  214.     case O_ASSIGN:
  215.     if (ed->arg[1].arg_flags & AF_ARYOK) {
  216.         if (ed->arg->arg_len == 1) {
  217.         ed->arg->arg_type = O_LOCAL;
  218.         goto local;
  219.         }
  220.         else {
  221.         ed->arg->arg_type = O_AASSIGN;
  222.         goto aassign;
  223.         }
  224.     }
  225.     else {
  226.         ed->arg->arg_type = O_SASSIGN;
  227.         goto sassign;
  228.     }
  229.     case O_LOCAL:
  230.       local:
  231.     ed->arglast[2] = ed->arglast[1];    /* push a null array */
  232.     /* FALL THROUGH */
  233.     case O_AASSIGN:
  234.       aassign:
  235.     ed->sp = do_assign(ed->arg,
  236.       ed->gimme,ed->arglast);
  237.     goto array_return;
  238.     case O_SASSIGN:
  239.       sassign:
  240.     STR_SSET(ed->str, ed->st[2]);
  241.     STABSET(ed->str);
  242.     break;
  243.     case O_CHOP:
  244.     ed->st -= ed->arglast[0];
  245.     ed->str = ed->arg->arg_ptr.arg_str;
  246.     for (ed->sp = ed->arglast[0] + 1; ed->sp <= ed->arglast[1]; ed->sp++)
  247.         do_chop(ed->str,ed->st[ed->sp]);
  248.     ed->st += ed->arglast[0];
  249.     break;
  250.     case O_DEFINED:
  251.     if (ed->arg[1].arg_type & A_DONT) {
  252.         ed->sp = do_defined(ed->str,ed->arg,
  253.           ed->gimme,ed->arglast);
  254.         goto array_return;
  255.     }
  256.     else if (ed->str->str_pok || ed->str->str_nok)
  257.         goto say_yes;
  258.     goto say_no;
  259.     case O_UNDEF:
  260.     if (ed->arg[1].arg_type & A_DONT) {
  261.         ed->sp = do_undef(ed->str,ed->arg,
  262.           ed->gimme,ed->arglast);
  263.         goto array_return;
  264.     }
  265.     else if (ed->str != stab_val(defstab)) {
  266.         if (ed->str->str_len) {
  267.         if (ed->str->str_state == SS_INCR)
  268.             Str_Grow(ed->str,0);
  269.         Safefree(ed->str->str_ptr);
  270.         ed->str->str_ptr = Nullch;
  271.         ed->str->str_len = 0;
  272.         }
  273.         ed->str->str_pok = ed->str->str_nok = 0;
  274.         STABSET(ed->str);
  275.     }
  276.     goto say_undef;
  277.     case O_STUDY:
  278.     ed->sp = do_study(ed->str,ed->arg,
  279.       ed->gimme,ed->arglast);
  280.     goto array_return;
  281.     case O_POW:
  282.     ed->value = str_gnum(ed->st[1]);
  283.     ed->value = pow(ed->value,str_gnum(ed->st[2]));
  284.     goto donumset;
  285.     case O_MULTIPLY:
  286.     ed->value = str_gnum(ed->st[1]);
  287.     ed->value *= str_gnum(ed->st[2]);
  288.     goto donumset;
  289.     case O_DIVIDE:
  290.     if ((ed->value = str_gnum(ed->st[2])) == 0.0)
  291.         fatal("Illegal division by zero");
  292.     ed->value = str_gnum(ed->st[1]) / ed->value;
  293.     goto donumset;
  294.     case O_MODULO:
  295.     ed->tmpulong = (unsigned long) str_gnum(ed->st[2]);
  296.         if (ed->tmpulong == 0L)
  297.         fatal("Illegal modulus zero");
  298.     ed->value = str_gnum(ed->st[1]);
  299.     if (ed->value >= 0.0)
  300.         ed->value = (double)((unsigned long) ed->value % ed->tmpulong);
  301.     else {
  302.         ed->tmplong = (long) ed->value;
  303.         ed->value   = (double)(ed->tmpulong - ((-ed->tmplong - 1) % ed->tmpulong)) - 1;
  304.     }
  305.     goto donumset;
  306.     case O_ADD:
  307.     ed->value = str_gnum(ed->st[1]);
  308.     ed->value += str_gnum(ed->st[2]);
  309.     goto donumset;
  310.     case O_SUBTRACT:
  311.     ed->value = str_gnum(ed->st[1]);
  312.     ed->value -= str_gnum(ed->st[2]);
  313.     goto donumset;
  314.     case O_LEFT_SHIFT:
  315.     ed->value = str_gnum(ed->st[1]);
  316.     ed->anum = (int)str_gnum(ed->st[2]);
  317.     ed->value = (double)(U_L(ed->value) << ed->anum);
  318.     goto donumset;
  319.     case O_RIGHT_SHIFT:
  320.     ed->value = str_gnum(ed->st[1]);
  321.     ed->anum = (int)str_gnum(ed->st[2]);
  322.     ed->value = (double)(U_L(ed->value) >> ed->anum);
  323.     goto donumset;
  324.     case O_LT:
  325.     ed->value = str_gnum(ed->st[1]);
  326.     ed->value = (ed->value < str_gnum(ed->st[2])) ? 1.0 : 0.0;
  327.     goto donumset;
  328.     case O_GT:
  329.     ed->value = str_gnum(ed->st[1]);
  330.     ed->value = (ed->value > str_gnum(ed->st[2])) ? 1.0 : 0.0;
  331.     goto donumset;
  332.     case O_LE:
  333.     ed->value = str_gnum(ed->st[1]);
  334.     ed->value = (ed->value <= str_gnum(ed->st[2])) ? 1.0 : 0.0;
  335.     goto donumset;
  336.     case O_GE:
  337.     ed->value = str_gnum(ed->st[1]);
  338.     ed->value = (ed->value >= str_gnum(ed->st[2])) ? 1.0 : 0.0;
  339.     goto donumset;
  340.     case O_EQ:
  341.     if (dowarn) {
  342.         if ((!ed->st[1]->str_nok && !looks_like_number(ed->st[1])) ||
  343.         (!ed->st[2]->str_nok && !looks_like_number(ed->st[2])) )
  344.         warn("Possible use of == on string ed->value");
  345.     }
  346.     ed->value = str_gnum(ed->st[1]);
  347.     ed->value = (ed->value == str_gnum(ed->st[2])) ? 1.0 : 0.0;
  348.     goto donumset;
  349.     case O_NE:
  350.     ed->value = str_gnum(ed->st[1]);
  351.     ed->value = (ed->value != str_gnum(ed->st[2])) ? 1.0 : 0.0;
  352.     goto donumset;
  353.     case O_NCMP:
  354.     ed->value = str_gnum(ed->st[1]);
  355.     ed->value -= str_gnum(ed->st[2]);
  356.     if (ed->value > 0.0)
  357.         ed->value = 1.0;
  358.     else if (ed->value < 0.0)
  359.         ed->value = -1.0;
  360.     goto donumset;
  361.     case O_BIT_AND:
  362.     if (!sawvec || ed->st[1]->str_nok || ed->st[2]->str_nok) {
  363.         ed->value = str_gnum(ed->st[1]);
  364.         ed->value = (double)(U_L(ed->value) & U_L(str_gnum(ed->st[2])));
  365.         goto donumset;
  366.     }
  367.     else
  368.         do_vop(ed->optype,ed->str,ed->st[1],ed->st[2]);
  369.     break;
  370.     case O_XOR:
  371.     if (!sawvec || ed->st[1]->str_nok || ed->st[2]->str_nok) {
  372.         ed->value = str_gnum(ed->st[1]);
  373.         ed->value = (double)(U_L(ed->value) ^ U_L(str_gnum(ed->st[2])));
  374.         goto donumset;
  375.     }
  376.     else
  377.         do_vop(ed->optype,ed->str,ed->st[1],ed->st[2]);
  378.     break;
  379.     case O_BIT_OR:
  380.     if (!sawvec || ed->st[1]->str_nok || ed->st[2]->str_nok) {
  381.         ed->value = str_gnum(ed->st[1]);
  382.         ed->value = (double)(U_L(ed->value) | U_L(str_gnum(ed->st[2])));
  383.         goto donumset;
  384.     }
  385.     else
  386.         do_vop(ed->optype,ed->str,ed->st[1],ed->st[2]);
  387.     break;
  388. /* use register in evaluating str_true() */
  389.     case O_AND:
  390.     if (str_true(ed->st[1])) {
  391.         ed->anum = 2;
  392.         ed->optype = O_ITEM2;
  393.         ed->argflags = ed->arg[ed->anum].arg_flags;
  394.         if (ed->gimme == G_ARRAY)
  395.         ed->argflags |= AF_ARYOK;
  396.         ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
  397.         ed->argptr = ed->arg[ed->anum].arg_ptr;
  398.         ed->maxarg = ed->anum = 1;
  399.         ed->sp = ed->arglast[0];
  400.         ed->st -= ed->sp;
  401.         goto re_eval;
  402.     }
  403.     else {
  404.         if (ed->assigning) {
  405.         str_sset(ed->str, ed->st[1]);
  406.         STABSET(ed->str);
  407.         }
  408.         else
  409.         ed->str = ed->st[1];
  410.         break;
  411.     }
  412.     case O_OR:
  413.     if (str_true(ed->st[1])) {
  414.         if (ed->assigning) {
  415.         str_sset(ed->str, ed->st[1]);
  416.         STABSET(ed->str);
  417.         }
  418.         else
  419.         ed->str = ed->st[1];
  420.         break;
  421.     }
  422.     else {
  423.         ed->anum = 2;
  424.         ed->optype = O_ITEM2;
  425.         ed->argflags = ed->arg[ed->anum].arg_flags;
  426.         if (ed->gimme == G_ARRAY)
  427.         ed->argflags |= AF_ARYOK;
  428.         ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
  429.         ed->argptr = ed->arg[ed->anum].arg_ptr;
  430.         ed->maxarg = ed->anum = 1;
  431.         ed->sp = ed->arglast[0];
  432.         ed->st -= ed->sp;
  433.         goto re_eval;
  434.     }
  435.     case O_COND_EXPR:
  436.     ed->anum = (str_true(ed->st[1]) ? 2 : 3);
  437.     ed->optype = (ed->anum == 2 ? O_ITEM2 : O_ITEM3);
  438.     ed->argflags = ed->arg[ed->anum].arg_flags;
  439.     if (ed->gimme == G_ARRAY)
  440.         ed->argflags |= AF_ARYOK;
  441.     ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
  442.     ed->argptr = ed->arg[ed->anum].arg_ptr;
  443.     ed->maxarg = ed->anum = 1;
  444.     ed->sp = ed->arglast[0];
  445.     ed->st -= ed->sp;
  446.     goto re_eval;
  447.     case O_COMMA:
  448.     if (ed->gimme == G_ARRAY)
  449.         goto array_return;
  450.     ed->str = ed->st[2];
  451.     break;
  452.     case O_NEGATE:
  453.     ed->value = -str_gnum(ed->st[1]);
  454.     goto donumset;
  455.     case O_NOT:
  456. #ifdef NOTNOT
  457.     { char xxx = str_true(st[1]); ed->value = (double) !xxx; }
  458. #else
  459.       ed->value = (double) !str_true(ed->st[1]);
  460. #endif
  461.     goto donumset;
  462.     case O_COMPLEMENT:
  463.     if (!sawvec || ed->st[1]->str_nok) {
  464.         ed->value = (double) ~U_L(str_gnum(ed->st[1]));
  465.         goto donumset;
  466.     }
  467.     else {
  468.         STR_SSET(ed->str,ed->st[1]);
  469.         ed->tmps = str_get(ed->str);
  470.         for (ed->anum = ed->str->str_cur; ed->anum; ed->anum--, ed->tmps++)
  471.         *ed->tmps = ~*ed->tmps;
  472.     }
  473.     break;
  474.     case O_SELECT:
  475.     stab_efullname(ed->str,defoutstab);
  476.     if (ed->maxarg > 0) {
  477.         if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  478.         defoutstab = ed->arg[1].arg_ptr.arg_stab;
  479.         else
  480.         defoutstab = stabent(str_get(ed->st[1]),TRUE);
  481.         if (!stab_io(defoutstab))
  482.         stab_io(defoutstab) = stio_new();
  483.         curoutstab = defoutstab;
  484.     }
  485.     STABSET(ed->str);
  486.     break;
  487.     case O_WRITE:
  488.     if (ed->maxarg == 0)
  489.         ed->stab = defoutstab;
  490.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD) {
  491.         if (!(ed->stab = ed->arg[1].arg_ptr.arg_stab))
  492.         ed->stab = defoutstab;
  493.     }
  494.     else
  495.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  496.     if (!stab_io(ed->stab)) {
  497.         str_set(ed->str, No);
  498.         STABSET(ed->str);
  499.         break;
  500.     }
  501.     curoutstab = ed->stab;
  502.     ed->fp = stab_io(ed->stab)->ofp;
  503.     debarg = ed->arg;
  504.     if (stab_io(ed->stab)->fmt_stab)
  505.         ed->form = stab_form(stab_io(ed->stab)->fmt_stab);
  506.     else
  507.         ed->form = stab_form(ed->stab);
  508.     if (!ed->form || !ed->fp) {
  509.         if (dowarn) {
  510.         if (ed->form)
  511.             warn("No format for filehandle");
  512.         else {
  513.             if (stab_io(ed->stab)->ifp)
  514.             warn("Filehandle only opened for input");
  515.             else
  516.             warn("Write on closed filehandle");
  517.         }
  518.         }
  519.         str_set(ed->str, No);
  520.         STABSET(ed->str);
  521.         break;
  522.     }
  523.     format(&outrec,ed->form,ed->sp);
  524.     do_write(&outrec,ed->stab,ed->sp);
  525.     if (stab_io(ed->stab)->flags & IOF_FLUSH)
  526.         (void)fflush(ed->fp);
  527.     str_set(ed->str, Yes);
  528.     STABSET(ed->str);
  529.     break;
  530.     case O_DBMOPEN:
  531. #ifdef SOME_DBM
  532.     ed->anum = ed->arg[1].arg_type & A_MASK;
  533.     if (ed->anum == A_WORD || ed->anum == A_STAB)
  534.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  535.     else
  536.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  537.     if (ed->st[3]->str_nok || ed->st[3]->str_pok)
  538.         ed->anum = (int)str_gnum(ed->st[3]);
  539.     else
  540.         ed->anum = -1;
  541.     ed->value = (double)hdbmopen(stab_hash(ed->stab),str_get(ed->st[2]),ed->anum);
  542.     goto donumset;
  543. #else
  544.     fatal("No dbm or ndbm on this machine");
  545. #endif
  546.     case O_DBMCLOSE:
  547. #ifdef SOME_DBM
  548.     ed->anum = ed->arg[1].arg_type & A_MASK;
  549.     if (ed->anum == A_WORD || ed->anum == A_STAB)
  550.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  551.     else
  552.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  553.     hdbmclose(stab_hash(ed->stab));
  554.     goto say_yes;
  555. #else
  556.     fatal("No dbm or ndbm on this machine");
  557. #endif
  558.     case O_OPEN:
  559.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  560.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  561.     else
  562.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  563.     ed->tmps = str_get(ed->st[2]);
  564.     if (do_open(ed->stab,ed->tmps,ed->st[2]->str_cur)) {
  565.         ed->value = (double)forkprocess;
  566.         stab_io(ed->stab)->lines = 0;
  567.         goto donumset;
  568.     }
  569.     else if (forkprocess == 0)        /* we are a new child */
  570.         goto say_zero;
  571.     else
  572.         goto say_undef;
  573.     /* break; */
  574.     case O_TRANS:
  575.     ed->value = (double) do_trans(ed->str,ed->arg);
  576.     ed->str = ed->arg->arg_ptr.arg_str;
  577.     goto donumset;
  578.     case O_NTRANS:
  579.     str_set(ed->arg->arg_ptr.arg_str, do_trans(ed->str,ed->arg) == 0 ? Yes : No);
  580.     ed->str = ed->arg->arg_ptr.arg_str;
  581.     break;
  582.     case O_CLOSE:
  583.     if (ed->maxarg == 0)
  584.         ed->stab = defoutstab;
  585.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  586.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  587.     else
  588.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  589.     str_set(ed->str, do_close(ed->stab,TRUE) ? Yes : No );
  590.     STABSET(ed->str);
  591.     break;
  592.     case O_EACH:
  593.     ed->sp = do_each(ed->str,stab_hash(ed->arg[1].arg_ptr.arg_stab),
  594.       ed->gimme,ed->arglast);
  595.     goto array_return;
  596.     case O_VALUES:
  597.     case O_KEYS:
  598.     ed->sp = do_kv(ed->str,stab_hash(ed->arg[1].arg_ptr.arg_stab), ed->optype,
  599.       ed->gimme,ed->arglast);
  600.     goto array_return;
  601.     case O_LARRAY:
  602.     ed->str->str_nok = ed->str->str_pok = 0;
  603.     ed->str->str_u.str_stab = ed->arg[1].arg_ptr.arg_stab;
  604.     ed->str->str_state = SS_ARY;
  605.     break;
  606.     case O_ARRAY:
  607.     ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab);
  608.     ed->maxarg = ed->ary->ary_fill + 1;
  609.     if (ed->gimme == G_ARRAY) { /* array wanted */
  610.         ed->sp = ed->arglast[0];
  611.         ed->st -= ed->sp;
  612.         if (ed->maxarg > 0 && ed->sp + ed->maxarg > stack->ary_max) {
  613.         astore(stack,ed->sp + ed->maxarg, Nullstr);
  614.         ed->st = stack->ary_array;
  615.         }
  616.         ed->st += ed->sp;
  617.         Copy(ed->ary->ary_array, &ed->st[1], ed->maxarg, STR*);
  618.         ed->sp += ed->maxarg;
  619.         goto array_return;
  620.     }
  621.     else {
  622.         ed->value = (double)ed->maxarg;
  623.         goto donumset;
  624.     }
  625.     case O_AELEM:
  626.     ed->anum = ((int)str_gnum(ed->st[2])) - arybase;
  627.     ed->str = afetch(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->anum,FALSE);
  628.     break;
  629.     case O_DELETE:
  630.     tmpstab = ed->arg[1].arg_ptr.arg_stab;
  631.     ed->tmps = str_get(ed->st[2]);
  632.     ed->str = hdelete(stab_hash(tmpstab),ed->tmps,ed->st[2]->str_cur);
  633.     if (tmpstab == envstab)
  634.         my_setenv(ed->tmps,Nullch);
  635.     if (!ed->str)
  636.         goto say_undef;
  637.     break;
  638.     case O_LHASH:
  639.     ed->str->str_nok = ed->str->str_pok = 0;
  640.     ed->str->str_u.str_stab = ed->arg[1].arg_ptr.arg_stab;
  641.     ed->str->str_state = SS_HASH;
  642.     break;
  643.     case O_HASH:
  644.     if (ed->gimme == G_ARRAY) { /* array wanted */
  645.         ed->sp = do_kv(ed->str,stab_hash(ed->arg[1].arg_ptr.arg_stab), ed->optype,
  646.         ed->gimme,ed->arglast);
  647.         goto array_return;
  648.     }
  649.     else {
  650.         tmpstab = ed->arg[1].arg_ptr.arg_stab;
  651.         if (!stab_hash(tmpstab)->tbl_fill)
  652.         goto say_zero;
  653.         sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
  654.         stab_hash(tmpstab)->tbl_max+1);
  655.         str_set(ed->str,buf);
  656.     }
  657.     break;
  658.     case O_HELEM:
  659.     tmpstab = ed->arg[1].arg_ptr.arg_stab;
  660.     ed->tmps = str_get(ed->st[2]);
  661.     ed->str = hfetch(stab_hash(tmpstab),ed->tmps,ed->st[2]->str_cur,FALSE);
  662.     break;
  663.     case O_LAELEM:
  664.     ed->anum = ((int)str_gnum(ed->st[2])) - arybase;
  665.     ed->str = afetch(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->anum,TRUE);
  666.     if (!ed->str || ed->str == &str_undef)
  667.         fatal("Assignment to non-creatable ed->value, subscript %d",ed->anum);
  668.     break;
  669.     case O_LHELEM:
  670.     tmpstab = ed->arg[1].arg_ptr.arg_stab;
  671.     ed->tmps = str_get(ed->st[2]);
  672.     ed->anum = ed->st[2]->str_cur;
  673.     ed->str = hfetch(stab_hash(tmpstab),ed->tmps,ed->anum,TRUE);
  674.     if (!ed->str || ed->str == &str_undef)
  675.         fatal("Assignment to non-creatable ed->value, subscript \"%s\"",ed->tmps);
  676.     if (tmpstab == envstab)        /* heavy wizardry going on here */
  677.         str_magic(ed->str, tmpstab, 'E', ed->tmps, ed->anum);    /* ed->str is now magic */
  678.                     /* he threw the brick up into the air */
  679.     else if (tmpstab == sigstab)
  680.         str_magic(ed->str, tmpstab, 'S', ed->tmps, ed->anum);
  681. #ifdef SOME_DBM
  682.     else if (stab_hash(tmpstab)->tbl_dbm)
  683.         str_magic(ed->str, tmpstab, 'D', ed->tmps, ed->anum);
  684. #endif
  685.     else if (tmpstab == DBline)
  686.         str_magic(ed->str, tmpstab, 'L', ed->tmps, ed->anum);
  687.     break;
  688.     case O_LSLICE:
  689.     ed->anum = 2;
  690.     ed->argtype = FALSE;
  691.     goto do_slice_already;
  692.     case O_ASLICE:
  693.     ed->anum = 1;
  694.     ed->argtype = FALSE;
  695.     goto do_slice_already;
  696.     case O_HSLICE:
  697.     ed->anum = 0;
  698.     ed->argtype = FALSE;
  699.     goto do_slice_already;
  700.     case O_LASLICE:
  701.     ed->anum = 1;
  702.     ed->argtype = TRUE;
  703.     goto do_slice_already;
  704.     case O_LHSLICE:
  705.     ed->anum = 0;
  706.     ed->argtype = TRUE;
  707.       do_slice_already:
  708.     ed->sp = do_slice(ed->arg[1].arg_ptr.arg_stab,ed->str,ed->anum,ed->argtype,
  709.         ed->gimme,ed->arglast);
  710.     goto array_return;
  711.     case O_SPLICE:
  712.     ed->sp = do_splice(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->gimme,ed->arglast);
  713.     goto array_return;
  714.     case O_PUSH:
  715.     if (ed->arglast[2] - ed->arglast[1] != 1)
  716.         ed->str = do_push(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->arglast);
  717.     else {
  718.         ed->str = Str_new(51,0);        /* must copy the ed->str */
  719.         str_sset(ed->str,ed->st[2]);
  720.         (void)apush(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->str);
  721.     }
  722.     break;
  723.     case O_POP:
  724.     ed->str = apop(ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab));
  725.     goto staticalization;
  726.     case O_SHIFT:
  727.     ed->str = ashift(ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab));
  728.       staticalization:
  729.     if (!ed->str)
  730.         goto say_undef;
  731.     if (ed->ary->ary_flags & ARF_REAL)
  732.         (void)str_2mortal(ed->str);
  733.     break;
  734.     case O_UNPACK:
  735.     ed->sp = do_unpack(ed->str,ed->gimme,ed->arglast);
  736.     goto array_return;
  737.     case O_SPLIT:
  738.     ed->value = str_gnum(ed->st[3]);
  739.     ed->sp = do_split(ed->str, ed->arg[2].arg_ptr.arg_spat, (int)ed->value,
  740.       ed->gimme,ed->arglast);
  741.     goto array_return;
  742.     case O_LENGTH:
  743.     if (ed->maxarg < 1)
  744.         ed->value = (double)str_len(stab_val(defstab));
  745.     else
  746.         ed->value = (double)str_len(ed->st[1]);
  747.     goto donumset;
  748.     case O_SPRINTF:
  749.     do_sprintf(ed->str, ed->sp-ed->arglast[0], ed->st+1);
  750.     break;
  751.     case O_SUBSTR:
  752.     ed->anum = ((int)str_gnum(ed->st[2])) - arybase;    /* ed->anum=where to start*/
  753.     ed->tmps = str_get(ed->st[1]);        /* force conversion to string */
  754.     /*SUPPRESS 560*/
  755.     if (ed->argtype = (ed->str == ed->st[1]))
  756.         ed->str = ed->arg->arg_ptr.arg_str;
  757.     if (ed->anum < 0)
  758.         ed->anum += ed->st[1]->str_cur + arybase;
  759.     if (ed->anum < 0 || ed->anum > ed->st[1]->str_cur)
  760.         str_nset(ed->str,"",0);
  761.     else {
  762.         ed->optype = ed->maxarg < 3 ? ed->st[1]->str_cur : (int)str_gnum(ed->st[3]);
  763.         if (ed->optype < 0)
  764.         ed->optype = 0;
  765.         ed->tmps += ed->anum;
  766.         ed->anum = ed->st[1]->str_cur - ed->anum;    /* ed->anum=how many bytes left*/
  767.         if (ed->anum > ed->optype)
  768.         ed->anum = ed->optype;
  769.         str_nset(ed->str, ed->tmps, ed->anum);
  770.         if (ed->argtype) {            /* it's an lvalue! */
  771.         lstr = (struct lstring*)ed->str;
  772.         ed->str->str_magic = ed->st[1];
  773.         ed->st[1]->str_rare = 's';
  774.         lstr->lstr_offset = ed->tmps - str_get(ed->st[1]); 
  775.         lstr->lstr_len = ed->anum; 
  776.         }
  777.     }
  778.     break;
  779.     default:
  780.         fatal("eval1 was incorrectly split");
  781.     }
  782. return R_nojump;
  783.  
  784. array_return:
  785.     return R_array_return;
  786. say_no:
  787.     return R_say_no;
  788. re_eval:
  789.     return R_re_eval;
  790. say_yes:
  791.     return R_say_yes;
  792. say_undef:
  793.     return R_say_undef;
  794. donumset:
  795.     return R_donumset;
  796. say_zero:
  797.     return R_say_zero;    
  798. }
  799.  
  800. EvalResult eval2(EvalData * ed)
  801. {
  802.     switch (ed->optype) {
  803.     case O_PACK:
  804.     /*SUPPRESS 701*/
  805.     (void)do_pack(ed->str,ed->arglast);
  806.     break;
  807.     case O_GREP:
  808.     ed->sp = do_grep(ed->arg,ed->str,ed->gimme,ed->arglast);
  809.     goto array_return;
  810.     case O_JOIN:
  811.     do_join(ed->str,ed->arglast);
  812.     break;
  813.     case O_SLT:
  814.     ed->tmps = str_get(ed->st[1]);
  815.     ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) < 0);
  816.     goto donumset;
  817.     case O_SGT:
  818.     ed->tmps = str_get(ed->st[1]);
  819.     ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) > 0);
  820.     goto donumset;
  821.     case O_SLE:
  822.     ed->tmps = str_get(ed->st[1]);
  823.     ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) <= 0);
  824.     goto donumset;
  825.     case O_SGE:
  826.     ed->tmps = str_get(ed->st[1]);
  827.     ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) >= 0);
  828.     goto donumset;
  829.     case O_SEQ:
  830.     ed->tmps = str_get(ed->st[1]);
  831.     ed->value = (double) str_eq(ed->st[1],ed->st[2]);
  832.     goto donumset;
  833.     case O_SNE:
  834.     ed->tmps = str_get(ed->st[1]);
  835.     ed->value = (double) !str_eq(ed->st[1],ed->st[2]);
  836.     goto donumset;
  837.     case O_SCMP:
  838.     ed->tmps = str_get(ed->st[1]);
  839.     ed->value = (double) str_cmp(ed->st[1],ed->st[2]);
  840.     goto donumset;
  841.     case O_SUBR:
  842.     ed->sp = do_subr(ed->arg,ed->gimme,ed->arglast);
  843.     ed->st = stack->ary_array + ed->arglast[0];        /* maybe realloced */
  844.     goto array_return;
  845.     case O_DBSUBR:
  846.     ed->sp = do_subr(ed->arg,ed->gimme,ed->arglast);
  847.     ed->st = stack->ary_array + ed->arglast[0];        /* maybe realloced */
  848.     goto array_return;
  849.     case O_CALLER:
  850.     ed->sp = do_caller(ed->arg,ed->maxarg,ed->gimme,ed->arglast);
  851.     ed->st = stack->ary_array + ed->arglast[0];        /* maybe realloced */
  852.     goto array_return;
  853.     case O_SORT:
  854.     ed->sp = do_sort(ed->str,ed->arg,
  855.       ed->gimme,ed->arglast);
  856.     goto array_return;
  857.     case O_REVERSE:
  858.     if (ed->gimme == G_ARRAY)
  859.         ed->sp = do_reverse(ed->arglast);
  860.     else
  861.         ed->sp = do_sreverse(ed->str, ed->arglast);
  862.     goto array_return;
  863.     case O_WARN:
  864.     if (ed->arglast[2] - ed->arglast[1] != 1) {
  865.         do_join(ed->str,ed->arglast);
  866.         ed->tmps = str_get(ed->str);
  867.     }
  868.     else {
  869.         ed->str = ed->st[2];
  870.         ed->tmps = str_get(ed->st[2]);
  871.     }
  872.     if (!ed->tmps || !*ed->tmps)
  873.         ed->tmps = "Warning: something's wrong";
  874.     warn("%s",ed->tmps);
  875.     goto say_yes;
  876.     case O_DIE:
  877.     if (ed->arglast[2] - ed->arglast[1] != 1) {
  878.         do_join(ed->str,ed->arglast);
  879.         ed->tmps = str_get(ed->str);
  880.     }
  881.     else {
  882.         ed->str = ed->st[2];
  883.         ed->tmps = str_get(ed->st[2]);
  884.     }
  885.     if (!ed->tmps || !*ed->tmps)
  886.         ed->tmps = "Died";
  887.     fatal("%s",ed->tmps);
  888.     goto say_zero;
  889.     case O_PRTF:
  890.     case O_PRINT:
  891.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  892.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  893.     else
  894.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  895.     if (!ed->stab)
  896.         ed->stab = defoutstab;
  897.     if (!stab_io(ed->stab)) {
  898.         if (dowarn)
  899.         warn("Filehandle never opened");
  900.         goto say_zero;
  901.     }
  902.     if (!(ed->fp = stab_io(ed->stab)->ofp)) {
  903.         if (dowarn)  {
  904.         if (stab_io(ed->stab)->ifp)
  905.             warn("Filehandle opened only for input");
  906.         else
  907.             warn("Print on closed filehandle");
  908.         }
  909.         goto say_zero;
  910.     }
  911.     else {
  912.         if (ed->optype == O_PRTF || ed->arglast[2] - ed->arglast[1] != 1)
  913.         ed->value = (double)do_aprint(ed->arg,ed->fp,ed->arglast);
  914.         else {
  915.         ed->value = (double)do_print(ed->st[2],ed->fp);
  916.         if (orslen && ed->optype == O_PRINT)
  917.             if (fwrite(ors, 1, orslen, ed->fp) == 0)
  918.             goto say_zero;
  919.         }
  920.         if (stab_io(ed->stab)->flags & IOF_FLUSH)
  921.         if (fflush(ed->fp) == EOF)
  922.             goto say_zero;
  923.     }
  924.     goto donumset;
  925.     case O_CHDIR:
  926.     if (ed->maxarg < 1)
  927.         ed->tmps = Nullch;
  928.     else
  929.         ed->tmps = str_get(ed->st[1]);
  930.     if (!ed->tmps || !*ed->tmps) {
  931.         ed->tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
  932.         ed->tmps = str_get(ed->tmpstr);
  933.     }
  934.     if (!ed->tmps || !*ed->tmps) {
  935.         ed->tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
  936.         ed->tmps = str_get(ed->tmpstr);
  937.     }
  938.     ed->value = (double)(chdir(ed->tmps) >= 0);
  939.     goto donumset;
  940.     case O_EXIT:
  941.     if (ed->maxarg < 1)
  942.         ed->anum = 0;
  943.     else
  944.         ed->anum = (int)str_gnum(ed->st[1]);
  945.     exit(ed->anum);
  946.     goto say_zero;
  947.     case O_RESET:
  948.     if (ed->maxarg < 1)
  949.         ed->tmps = "";
  950.     else
  951.         ed->tmps = str_get(ed->st[1]);
  952.     str_reset(ed->tmps,curcmd->c_stash);
  953.     ed->value = 1.0;
  954.     goto donumset;
  955.     case O_LIST:
  956.     if (ed->gimme == G_ARRAY)
  957.         goto array_return;
  958.     if (ed->maxarg > 0)
  959.         ed->str = ed->st[ed->sp - ed->arglast[0]];    /* unwanted list, return last item */
  960.     else
  961.         ed->str = &str_undef;
  962.     break;
  963.     case O_EOF:
  964.     if (ed->maxarg <= 0)
  965.         ed->stab = last_in_stab;
  966.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  967.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  968.     else
  969.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  970.     str_set(ed->str, do_eof(ed->stab) ? Yes : No);
  971.     STABSET(ed->str);
  972.     break;
  973.     case O_GETC:
  974.     if (ed->maxarg <= 0)
  975.         ed->stab = stdinstab;
  976.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  977.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  978.     else
  979.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  980.     if (!ed->stab)
  981.         ed->stab = argvstab;
  982.     if (!ed->stab || do_eof(ed->stab)) /* make sure we have ed->fp with something */
  983.         goto say_undef;
  984.     else {
  985.         str_set(ed->str," ");
  986.         *ed->str->str_ptr = getc(stab_io(ed->stab)->ifp); /* should never be EOF */
  987.     }
  988.     STABSET(ed->str);
  989.     break;
  990.     case O_TELL:
  991.     if (ed->maxarg <= 0)
  992.         ed->stab = last_in_stab;
  993.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  994.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  995.     else
  996.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  997.     ed->value = (double)do_tell(ed->stab);
  998.     goto donumset;
  999.     case O_RECV:
  1000.     case O_READ:
  1001.     case O_SYSREAD:
  1002.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  1003.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  1004.     else
  1005.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  1006.     ed->tmps = str_get(ed->st[2]);
  1007.     ed->anum = (int)str_gnum(ed->st[3]);
  1008.     errno = 0;
  1009.     ed->maxarg = ed->sp - ed->arglast[0];
  1010.     if (ed->maxarg > 4)
  1011.         warn("Too many args on read");
  1012.     if (ed->maxarg == 4)
  1013.         ed->maxarg = (int)str_gnum(ed->st[4]);
  1014.     else
  1015.         ed->maxarg = 0;
  1016.     if (!stab_io(ed->stab) || !stab_io(ed->stab)->ifp)
  1017.         goto say_undef;
  1018. #ifdef HAS_SOCKET
  1019.     if (ed->optype == O_RECV) {
  1020.         ed->argtype = sizeof buf;
  1021.         STR_GROW(ed->st[2], ed->anum+1), (ed->tmps = str_get(ed->st[2]));  /* sneaky */
  1022.         ed->anum = recvfrom(fileno(stab_io(ed->stab)->ifp), ed->tmps, ed->anum, ed->maxarg,
  1023.         buf, &ed->argtype);
  1024.         if (ed->anum >= 0) {
  1025.         ed->st[2]->str_cur = ed->anum;
  1026.         ed->st[2]->str_ptr[ed->anum] = '\0';
  1027.         str_nset(ed->str,buf,ed->argtype);
  1028.         }
  1029.         else
  1030.         str_sset(ed->str,&str_undef);
  1031.         break;
  1032.     }
  1033. #else
  1034.     if (ed->optype == O_RECV)
  1035.         goto badsock;
  1036. #endif
  1037.     STR_GROW(ed->st[2], ed->anum+ed->maxarg+1), (ed->tmps = str_get(ed->st[2]));  /* sneaky */
  1038.     if (ed->optype == O_SYSREAD) {
  1039.         ed->anum = read(fileno(stab_io(ed->stab)->ifp), ed->tmps+ed->maxarg, ed->anum);
  1040.     }
  1041.     else
  1042. #ifdef HAS_SOCKET
  1043.     if (stab_io(ed->stab)->type == 's') {
  1044.         ed->argtype = sizeof buf;
  1045.         ed->anum = recvfrom(fileno(stab_io(ed->stab)->ifp), ed->tmps+ed->maxarg, ed->anum, 0,
  1046.         buf, &ed->argtype);
  1047.     }
  1048.     else
  1049. #endif
  1050.         ed->anum = fread(ed->tmps+ed->maxarg, 1, ed->anum, stab_io(ed->stab)->ifp);
  1051.     if (ed->anum < 0)
  1052.         goto say_undef;
  1053.     ed->st[2]->str_cur = ed->anum+ed->maxarg;
  1054.     ed->st[2]->str_ptr[ed->anum+ed->maxarg] = '\0';
  1055.     ed->value = (double)ed->anum;
  1056.     goto donumset;
  1057.     case O_SYSWRITE:
  1058.     case O_SEND:
  1059.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  1060.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  1061.     else
  1062.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  1063.     ed->tmps = str_get(ed->st[2]);
  1064.     ed->anum = (int)str_gnum(ed->st[3]);
  1065.     errno = 0;
  1066.     stio = stab_io(ed->stab);
  1067.     ed->maxarg = ed->sp - ed->arglast[0];
  1068.     if (!stio || !stio->ifp) {
  1069.         ed->anum = -1;
  1070.         if (dowarn) {
  1071.         if (ed->optype == O_SYSWRITE)
  1072.             warn("Syswrite on closed filehandle");
  1073.         else
  1074.             warn("Send on closed socket");
  1075.         }
  1076.     }
  1077.     else if (ed->optype == O_SYSWRITE) {
  1078.         if (ed->maxarg > 4)
  1079.         warn("Too many args on syswrite");
  1080.         if (ed->maxarg == 4)
  1081.         ed->optype = (int)str_gnum(ed->st[4]);
  1082.         else
  1083.         ed->optype = 0;
  1084.         ed->anum = write(fileno(stab_io(ed->stab)->ifp), ed->tmps+ed->optype, ed->anum);
  1085.     }
  1086. #ifdef HAS_SOCKET
  1087.     else if (ed->maxarg >= 4) {
  1088.         if (ed->maxarg > 4)
  1089.         warn("Too many args on send");
  1090.         ed->tmps2 = str_get(ed->st[4]);
  1091.         ed->anum = sendto(fileno(stab_io(ed->stab)->ifp), ed->tmps, ed->st[2]->str_cur,
  1092.           ed->anum, ed->tmps2, ed->st[4]->str_cur);
  1093.     }
  1094.     else
  1095.         ed->anum = send(fileno(stab_io(ed->stab)->ifp), ed->tmps, ed->st[2]->str_cur, ed->anum);
  1096. #else
  1097.     else
  1098.         goto badsock;
  1099. #endif
  1100.     if (ed->anum < 0)
  1101.         goto say_undef;
  1102.     ed->value = (double)ed->anum;
  1103.     goto donumset;
  1104.     case O_SEEK:
  1105.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  1106.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  1107.     else
  1108.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  1109.     ed->value = str_gnum(ed->st[2]);
  1110.     str_set(ed->str, do_seek(ed->stab,
  1111.       (long)ed->value, (int)str_gnum(ed->st[3]) ) ? Yes : No);
  1112.     STABSET(ed->str);
  1113.     break;
  1114.     case O_RETURN:
  1115.     ed->tmps = "_SUB_";        /* just fake up a "last _SUB_" */
  1116.     ed->optype = O_LAST;
  1117.     if (curcsv && curcsv->wantarray == G_ARRAY) {
  1118.         lastretstr = Nullstr;
  1119.         lastspbase = ed->arglast[1];
  1120.         lastsize = ed->arglast[2] - ed->arglast[1];
  1121.     }
  1122.     else
  1123.         lastretstr = str_mortal(ed->st[ed->arglast[2] - ed->arglast[0]]);
  1124.     goto dopop;
  1125.     case O_REDO:
  1126.     case O_NEXT:
  1127.     case O_LAST:
  1128.     ed->tmps = Nullch;
  1129.     if (ed->maxarg > 0) {
  1130.         ed->tmps = str_get(ed->arg[1].arg_ptr.arg_str);
  1131.       dopop:
  1132.         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1133.           strNE(ed->tmps,loop_stack[loop_ptr].loop_label) )) {
  1134. #ifdef DEBUGGING
  1135.         if (debug & 4) {
  1136.             deb("(Skipping label #%d %s)\n",loop_ptr,
  1137.             loop_stack[loop_ptr].loop_label);
  1138.         }
  1139. #endif
  1140.         loop_ptr--;
  1141.         }
  1142. #ifdef DEBUGGING
  1143.         if (debug & 4) {
  1144.         deb("(Found label #%d %s)\n",loop_ptr,
  1145.             loop_stack[loop_ptr].loop_label);
  1146.         }
  1147. #endif
  1148.     }
  1149.     if (loop_ptr < 0) {
  1150.         if (ed->tmps && strEQ(ed->tmps, "_SUB_"))
  1151.         fatal("Can't return outside a subroutine");
  1152.         fatal("Bad label: %s", ed->maxarg > 0 ? ed->tmps : "<null>");
  1153.     }
  1154.     if (!lastretstr && ed->optype == O_LAST && lastsize) {
  1155.         ed->st -= ed->arglast[0];
  1156.         ed->st += lastspbase + 1;
  1157.         ed->optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
  1158.         if (ed->optype) {
  1159.         for (ed->anum = lastsize; ed->anum > 0; ed->anum--,ed->st++)
  1160.             ed->st[ed->optype] = str_mortal(ed->st[0]);
  1161.         }
  1162.         longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
  1163.     }
  1164.     longjmp(loop_stack[loop_ptr].loop_env, ed->optype);
  1165.     case O_DUMP:
  1166.     case O_GOTO:/* shudder */
  1167.     goto_targ = str_get(ed->arg[1].arg_ptr.arg_str);
  1168.     if (!*goto_targ)
  1169.         goto_targ = Nullch;        /* just restart from top */
  1170.     if (ed->optype == O_DUMP) {
  1171.         do_undump = 1;
  1172.         my_unexec();
  1173.     }
  1174.     longjmp(top_env, 1);
  1175.     case O_INDEX:
  1176.     ed->tmps = str_get(ed->st[1]);
  1177.     if (ed->maxarg < 3)
  1178.         ed->anum = 0;
  1179.     else {
  1180.         ed->anum = (int) str_gnum(ed->st[3]) - arybase;
  1181.         if (ed->anum < 0)
  1182.         ed->anum = 0;
  1183.         else if (ed->anum > ed->st[1]->str_cur)
  1184.         ed->anum = ed->st[1]->str_cur;
  1185.     }
  1186.     if (!(ed->tmps2 = fbminstr((unsigned char*)ed->tmps + ed->anum,
  1187.       (unsigned char*)ed->tmps + ed->st[1]->str_cur, ed->st[2])))
  1188.         ed->value = (double)(-1 + arybase);
  1189.     else
  1190.         ed->value = (double)(ed->tmps2 - ed->tmps + arybase);
  1191.     goto donumset;
  1192.     case O_RINDEX:
  1193.     ed->tmps = str_get(ed->st[1]);
  1194.     ed->tmps2 = str_get(ed->st[2]);
  1195.     if (ed->maxarg < 3)
  1196.         ed->anum = ed->st[1]->str_cur;
  1197.     else {
  1198.         ed->anum = (int) str_gnum(ed->st[3]) - arybase + ed->st[2]->str_cur;
  1199.         if (ed->anum < 0)
  1200.         ed->anum = 0;
  1201.         else if (ed->anum > ed->st[1]->str_cur)
  1202.         ed->anum = ed->st[1]->str_cur;
  1203.     }
  1204.     if (!(ed->tmps2 = rninstr(ed->tmps,  ed->tmps  + ed->anum,
  1205.                   ed->tmps2, ed->tmps2 + ed->st[2]->str_cur)))
  1206.         ed->value = (double)(-1 + arybase);
  1207.     else
  1208.         ed->value = (double)(ed->tmps2 - ed->tmps + arybase);
  1209.     goto donumset;
  1210.     case O_TIME:
  1211.     ed->value = (double) time(Null(time_t*));
  1212.     goto donumset;
  1213.     case O_TMS:
  1214.     ed->sp = do_tms(ed->str,ed->gimme,ed->arglast);
  1215.     goto array_return;
  1216.     case O_LOCALTIME:
  1217.     if (ed->maxarg < 1)
  1218.         (void)time(&ed->when);
  1219.     else
  1220.         ed->when = (time_t)str_gnum(ed->st[1]);
  1221.     ed->sp = do_time(ed->str,localtime(&ed->when),
  1222.       ed->gimme,ed->arglast);
  1223.     goto array_return;
  1224.     case O_GMTIME:
  1225.     if (ed->maxarg < 1)
  1226.         (void)time(&ed->when);
  1227.     else
  1228.         ed->when = (time_t)str_gnum(ed->st[1]);
  1229.     ed->sp = do_time(ed->str,gmtime(&ed->when),
  1230.       ed->gimme,ed->arglast);
  1231.     goto array_return;
  1232.     case O_TRUNCATE:
  1233.     ed->sp = do_truncate(ed->str,ed->arg,
  1234.       ed->gimme,ed->arglast);
  1235.     goto array_return;
  1236.     case O_LSTAT:
  1237.     case O_STAT:
  1238.     ed->sp = do_stat(ed->str,ed->arg,
  1239.       ed->gimme,ed->arglast);
  1240.     goto array_return;
  1241.     case O_CRYPT:
  1242. #ifdef HAS_CRYPT
  1243.     ed->tmps = str_get(ed->st[1]);
  1244. #ifdef FCRYPT
  1245.     str_set(ed->str,fcrypt(ed->tmps,str_get(ed->st[2])));
  1246. #else
  1247.     str_set(ed->str,crypt(ed->tmps,str_get(ed->st[2])));
  1248. #endif
  1249. #else
  1250.     fatal(
  1251.       "The crypt() function is unimplemented due to excessive paranoia.");
  1252. #endif
  1253.     break;
  1254.     case O_ATAN2:
  1255.     ed->value = str_gnum(ed->st[1]);
  1256.     ed->value = atan2(ed->value,str_gnum(ed->st[2]));
  1257.     goto donumset;
  1258.     case O_SIN:
  1259.     if (ed->maxarg < 1)
  1260.         ed->value = str_gnum(stab_val(defstab));
  1261.     else
  1262.         ed->value = str_gnum(ed->st[1]);
  1263.     ed->value = sin(ed->value);
  1264.     goto donumset;
  1265.     case O_COS:
  1266.     if (ed->maxarg < 1)
  1267.         ed->value = str_gnum(stab_val(defstab));
  1268.     else
  1269.         ed->value = str_gnum(ed->st[1]);
  1270.     ed->value = cos(ed->value);
  1271.     goto donumset;
  1272.     case O_RAND:
  1273.     if (ed->maxarg < 1)
  1274.         ed->value = 1.0;
  1275.     else
  1276.         ed->value = str_gnum(ed->st[1]);
  1277.     if (ed->value == 0.0)
  1278.         ed->value = 1.0;
  1279. #if RANDBITS == 31
  1280.     ed->value = rand() * ed->value / 2147483648.0;
  1281. #else
  1282. #if RANDBITS == 16
  1283.     ed->value = rand() * ed->value / 65536.0;
  1284. #else
  1285. #if RANDBITS == 15
  1286.     ed->value = rand() * ed->value / 32768.0;
  1287. #else
  1288.     ed->value = rand() * ed->value / (double)(((unsigned long)1) << RANDBITS);
  1289. #endif
  1290. #endif
  1291. #endif
  1292.     goto donumset;
  1293.     case O_SRAND:
  1294.     if (ed->maxarg < 1) {
  1295.         (void)time(&ed->when);
  1296.         ed->anum = ed->when;
  1297.     }
  1298.     else
  1299.         ed->anum = (int)str_gnum(ed->st[1]);
  1300.     srand(ed->anum);
  1301.     goto say_yes;
  1302.     case O_EXP:
  1303.     if (ed->maxarg < 1)
  1304.         ed->value = str_gnum(stab_val(defstab));
  1305.     else
  1306.         ed->value = str_gnum(ed->st[1]);
  1307.     ed->value = exp(ed->value);
  1308.     goto donumset;
  1309.     case O_LOG:
  1310.     if (ed->maxarg < 1)
  1311.         ed->value = str_gnum(stab_val(defstab));
  1312.     else
  1313.         ed->value = str_gnum(ed->st[1]);
  1314.     if (ed->value <= 0.0)
  1315.         fatal("Can't take log of %g\n", ed->value);
  1316.     ed->value = log(ed->value);
  1317.     goto donumset;
  1318.     case O_SQRT:
  1319.     if (ed->maxarg < 1)
  1320.         ed->value = str_gnum(stab_val(defstab));
  1321.     else
  1322.         ed->value = str_gnum(ed->st[1]);
  1323.     if (ed->value < 0.0)
  1324.         fatal("Can't take sqrt of %g\n", ed->value);
  1325.     ed->value = sqrt(ed->value);
  1326.     goto donumset;
  1327.     case O_INT:
  1328.     if (ed->maxarg < 1)
  1329.         ed->value = str_gnum(stab_val(defstab));
  1330.     else
  1331.         ed->value = str_gnum(ed->st[1]);
  1332.     {
  1333.          extended    intpart;
  1334.         
  1335.         if (ed->value >= 0.0)
  1336.             (void)modf(ed->value,&intpart);
  1337.         else {
  1338.             (void)modf(-ed->value,&intpart);
  1339.             intpart = -intpart;
  1340.         }
  1341.         
  1342.         ed->value = intpart;
  1343.     }
  1344.     goto donumset;
  1345.     case O_ORD:
  1346.     if (ed->maxarg < 1)
  1347.         ed->tmps = str_get(stab_val(defstab));
  1348.     else
  1349.         ed->tmps = str_get(ed->st[1]);
  1350.     ed->value = (double) (*ed->tmps & 255);
  1351.     goto donumset;
  1352.     case O_ALARM:
  1353. #ifdef HAS_ALARM
  1354.     if (ed->maxarg < 1)
  1355.         ed->tmps = str_get(stab_val(defstab));
  1356.     else
  1357.         ed->tmps = str_get(ed->st[1]);
  1358.     if (!ed->tmps)
  1359.         ed->tmps = "0";
  1360.     ed->anum = alarm((unsigned int)atoi(ed->tmps));
  1361.     if (ed->anum < 0)
  1362.         goto say_undef;
  1363.     ed->value = (double)ed->anum;
  1364.     goto donumset;
  1365. #else
  1366.     fatal("Unsupported function alarm");
  1367.     break;
  1368. #endif
  1369.     case O_SLEEP:
  1370.     if (ed->maxarg < 1)
  1371.         ed->tmps = Nullch;
  1372.     else
  1373.         ed->tmps = str_get(ed->st[1]);
  1374.     (void)time(&ed->when);
  1375.     if (!ed->tmps || !*ed->tmps)
  1376.         sleep((32767<<16)+32767);
  1377.     else
  1378.         sleep((unsigned int)atoi(ed->tmps));
  1379.     ed->value = (double)ed->when;
  1380.     (void)time(&ed->when);
  1381.     ed->value = ((double)ed->when) - ed->value;
  1382.     goto donumset;
  1383.     case O_RANGE:
  1384.     ed->sp = do_range(ed->gimme,ed->arglast);
  1385.     goto array_return;
  1386.     case O_F_OR_R:
  1387.     if (ed->gimme == G_ARRAY) {        /* it's a range */
  1388.         /* can we optimize to constant array? */
  1389.         if ((ed->arg[1].arg_type & A_MASK) == A_SINGLE &&
  1390.           (ed->arg[2].arg_type & A_MASK) == A_SINGLE) {
  1391.         ed->st[2] = ed->arg[2].arg_ptr.arg_str;
  1392.         ed->sp = do_range(ed->gimme,ed->arglast);
  1393.         ed->st = stack->ary_array;
  1394.         ed->maxarg = ed->sp - ed->arglast[0];
  1395.         str_free(ed->arg[1].arg_ptr.arg_str);
  1396.         ed->arg[1].arg_ptr.arg_str = Nullstr;
  1397.         str_free(ed->arg[2].arg_ptr.arg_str);
  1398.         ed->arg[2].arg_ptr.arg_str = Nullstr;
  1399.         ed->arg->arg_type = O_ARRAY;
  1400.         ed->arg[1].arg_type = A_STAB|A_DONT;
  1401.         ed->arg->arg_len = 1;
  1402.         ed->stab = ed->arg[1].arg_ptr.arg_stab = aadd(genstab());
  1403.         ed->ary = stab_array(ed->stab);
  1404.         afill(ed->ary,ed->maxarg - 1);
  1405.         ed->anum = ed->maxarg;
  1406.         ed->st += ed->arglast[0]+1;
  1407.         while (ed->maxarg-- > 0)
  1408.             ed->ary->ary_array[ed->maxarg] = str_smake(ed->st[ed->maxarg]);
  1409.         ed->st -= ed->arglast[0]+1;
  1410.         goto array_return;
  1411.         }
  1412.         ed->arg->arg_type = ed->optype = O_RANGE;
  1413.         ed->maxarg = ed->arg->arg_len = 2;
  1414.         ed->anum = 2;
  1415.         ed->arg[ed->anum].arg_flags &= ~AF_ARYOK;
  1416.         ed->argflags = ed->arg[ed->anum].arg_flags;
  1417.         ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
  1418.         ed->arg[ed->anum].arg_type = ed->argtype;
  1419.         ed->argptr = ed->arg[ed->anum].arg_ptr;
  1420.         ed->sp = ed->arglast[0];
  1421.         ed->st -= ed->sp;
  1422.         ed->sp++;
  1423.         goto re_eval;
  1424.     }
  1425.     ed->arg->arg_type = O_FLIP;
  1426.     /* FALL THROUGH */
  1427.     case O_FLIP:
  1428.     if ((ed->arg[1].arg_type & A_MASK) == A_SINGLE ?
  1429.       last_in_stab && (int)str_gnum(ed->st[1]) == stab_io(last_in_stab)->lines
  1430.       :
  1431.       str_true(ed->st[1]) ) {
  1432.         ed->arg[2].arg_type &= ~A_DONT;
  1433.         ed->arg[1].arg_type |= A_DONT;
  1434.         ed->arg->arg_type = ed->optype = O_FLOP;
  1435.         if (ed->arg->arg_flags & AF_COMMON) {
  1436.         str_numset(ed->str,0.0);
  1437.         ed->anum = 2;
  1438.         ed->argflags = ed->arg[2].arg_flags;
  1439.         ed->argtype = ed->arg[2].arg_type & A_MASK;
  1440.         ed->argptr = ed->arg[2].arg_ptr;
  1441.         ed->sp = ed->arglast[0];
  1442.         ed->st -= ed->sp++;
  1443.         goto re_eval;
  1444.         }
  1445.         else {
  1446.         str_numset(ed->str,1.0);
  1447.         break;
  1448.         }
  1449.     }
  1450.     str_set(ed->str,"");
  1451.     break;
  1452.     case O_FLOP:
  1453.     str_inc(ed->str);
  1454.     if ((ed->arg[2].arg_type & A_MASK) == A_SINGLE ?
  1455.       last_in_stab && (int)str_gnum(ed->st[2]) == stab_io(last_in_stab)->lines
  1456.       :
  1457.       str_true(ed->st[2]) ) {
  1458.         ed->arg->arg_type = O_FLIP;
  1459.         ed->arg[1].arg_type &= ~A_DONT;
  1460.         ed->arg[2].arg_type |= A_DONT;
  1461.         str_cat(ed->str,"E0");
  1462.     }
  1463.     break;
  1464.     case O_FORK:
  1465.     fatal("Unsupported function fork");
  1466.     break;
  1467.     case O_WAIT:
  1468.     fatal("Unsupported function wait");
  1469.     break;
  1470.     case O_WAITPID:
  1471.     fatal("Unsupported function wait");
  1472.     break;
  1473.     case O_SYSTEM:
  1474.     if ((ed->arg[1].arg_type & A_MASK) == A_STAB)
  1475.         ed->value = (double)do_aspawn(ed->st[1],ed->arglast);
  1476.     else if (ed->arglast[2] - ed->arglast[1] != 1)
  1477.         ed->value = (double)do_aspawn(Nullstr,ed->arglast);
  1478.     else {
  1479.         ed->value = (double)do_spawn(str_get(str_mortal(ed->st[2])));
  1480.     }
  1481.     goto donumset;
  1482.     case O_EXEC_OP:
  1483.     if ((ed->arg[1].arg_type & A_MASK) == A_STAB)
  1484.         ed->value = (double)do_aexec(ed->st[1],ed->arglast);
  1485.     else if (ed->arglast[2] - ed->arglast[1] != 1)
  1486.         ed->value = (double)do_aexec(Nullstr,ed->arglast);
  1487.     else {
  1488.         ed->value = (double)do_exec(str_get(str_mortal(ed->st[2])));
  1489.     }
  1490.     goto donumset;
  1491.     case O_HEX:
  1492.     if (ed->maxarg < 1)
  1493.         ed->tmps = str_get(stab_val(defstab));
  1494.     else
  1495.         ed->tmps = str_get(ed->st[1]);
  1496.     ed->value = (double)scanhex(ed->tmps, 99, &ed->argtype);
  1497.     goto donumset;
  1498.  
  1499.     case O_OCT:
  1500.     if (ed->maxarg < 1)
  1501.         ed->tmps = str_get(stab_val(defstab));
  1502.     else
  1503.         ed->tmps = str_get(ed->st[1]);
  1504.     while (*ed->tmps && (isSPACE(*ed->tmps) || *ed->tmps == '0'))
  1505.         ed->tmps++;
  1506.     if (*ed->tmps == 'x')
  1507.         ed->value = (double)scanhex(++ed->tmps, 99, &ed->argtype);
  1508.     else
  1509.         ed->value = (double)scanoct(ed->tmps, 99, &ed->argtype);
  1510.     goto donumset;
  1511.     default:
  1512.     fatal("eval2 was incorrectly split");
  1513.     }
  1514. return R_nojump;
  1515.  
  1516. array_return:
  1517.     return R_array_return;
  1518. re_eval:
  1519.     return R_re_eval;
  1520. #ifndef HAS_SOCKET
  1521. badsock:
  1522.     return R_badsock;
  1523. #endif
  1524. say_yes:
  1525.     return R_say_yes;
  1526. say_undef:
  1527.     return R_say_undef;
  1528. donumset:
  1529.     return R_donumset;
  1530. say_zero:
  1531.     return R_say_zero;    
  1532. }
  1533.  
  1534. int
  1535. eval(arg,gimme,sp)
  1536. register ARG *arg;
  1537. int gimme;
  1538. register int sp;
  1539. {
  1540.     EvalData    edt;
  1541.     EvalData *    ed;
  1542.     
  1543.     ed                =    &edt;
  1544.     ed->arg            =    arg;
  1545.     ed->gimme        =    gimme;
  1546.     ed->sp            =    sp;
  1547.     ed->assigning    =    FALSE;
  1548.     
  1549.     if (!ed->arg)
  1550.     goto say_undef;
  1551.     ed->optype = ed->arg->arg_type;
  1552.     ed->maxarg = ed->arg->arg_len;
  1553.     ed->arglast[0] = ed->sp;
  1554.     ed->str = ed->arg->arg_ptr.arg_str;
  1555.     if (ed->sp + ed->maxarg > stack->ary_max)
  1556.     astore(stack, ed->sp + ed->maxarg, Nullstr);
  1557.     ed->st = stack->ary_array;
  1558.  
  1559. #ifdef DEBUGGING
  1560.     if (debug) {
  1561.     if (debug & 8) {
  1562.         deb("%s (%lx) %d args:\n",opname[ed->optype],ed->arg,ed->maxarg);
  1563.     }
  1564.     debname[dlevel] = opname[ed->optype][0];
  1565.     debdelim[dlevel] = ':';
  1566.     if (++dlevel >= dlmax)
  1567.         grow_dlevel();
  1568.     }
  1569. #endif
  1570.  
  1571.     for (ed->anum = 1; ed->anum <= ed->maxarg; ed->anum++) {
  1572.     ed->argflags = ed->arg[ed->anum].arg_flags;
  1573.     ed->argtype = ed->arg[ed->anum].arg_type;
  1574.     ed->argptr = ed->arg[ed->anum].arg_ptr;
  1575.       re_eval:
  1576.     switch (ed->argtype) {
  1577.     default:
  1578.         ed->st[++ed->sp] = &str_undef;
  1579. #ifdef DEBUGGING
  1580.         ed->tmps = "NULL";
  1581. #endif
  1582.         break;
  1583.     case A_EXPR:
  1584. #ifdef DEBUGGING
  1585.         if (debug & 8) {
  1586.         ed->tmps = "EXPR";
  1587.         deb("%d.EXPR =>\n",ed->anum);
  1588.         }
  1589. #endif
  1590.         ed->sp = eval(ed->argptr.arg_arg,
  1591.         (ed->argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, ed->sp);
  1592.         if (ed->sp + (ed->maxarg - ed->anum) > stack->ary_max)
  1593.         astore(stack, ed->sp + (ed->maxarg - ed->anum), Nullstr);
  1594.         ed->st = stack->ary_array;    /* possibly reallocated */
  1595.         break;
  1596.         case A_CMD:
  1597. #ifdef DEBUGGING
  1598.         if (debug & 8) {
  1599.         ed->tmps = "CMD";
  1600.         deb("%d.CMD (%lx) =>\n",ed->anum,ed->argptr.arg_cmd);
  1601.         }
  1602. #endif
  1603.         ed->sp = cmd_exec(ed->argptr.arg_cmd, ed->gimme, ed->sp);
  1604.         if (ed->sp + (ed->maxarg - ed->anum) > stack->ary_max)
  1605.         astore(stack, ed->sp + (ed->maxarg - ed->anum), Nullstr);
  1606.         ed->st = stack->ary_array;    /* possibly reallocated */
  1607.         break;
  1608.         case A_LARYSTAB:
  1609.         ++ed->sp;
  1610.         switch (ed->optype) {
  1611.         case O_ITEM2: ed->argtype = 2; break;
  1612.         case O_ITEM3: ed->argtype = 3; break;
  1613.         default:      ed->argtype = ed->anum; break;
  1614.         }
  1615.         ed->str = afetch(stab_array(ed->argptr.arg_stab),
  1616.         ed->arg[ed->argtype].arg_len - arybase, TRUE);
  1617. #ifdef DEBUGGING
  1618.         if (debug & 8) {
  1619.         (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(ed->argptr.arg_stab),
  1620.             ed->arg[ed->argtype].arg_len);
  1621.         ed->tmps = buf;
  1622.         }
  1623. #endif
  1624.         goto do_crement;
  1625.         case A_ARYSTAB:
  1626.         switch (ed->optype) {
  1627.         case O_ITEM2: ed->argtype = 2; break;
  1628.         case O_ITEM3: ed->argtype = 3; break;
  1629.         default:      ed->argtype = ed->anum; break;
  1630.         }
  1631.         ed->st[++ed->sp] = afetch(stab_array(ed->argptr.arg_stab),
  1632.         ed->arg[ed->argtype].arg_len - arybase, FALSE);
  1633. #ifdef DEBUGGING
  1634.         if (debug & 8) {
  1635.         (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(ed->argptr.arg_stab),
  1636.             ed->arg[ed->argtype].arg_len);
  1637.         ed->tmps = buf;
  1638.         }
  1639. #endif
  1640.         break;
  1641.     case A_STAR:
  1642.         ed->stab = ed->argptr.arg_stab;
  1643.         ed->st[++ed->sp] = (STR*)ed->stab;
  1644.         if (!stab_xarray(ed->stab))
  1645.         aadd(ed->stab);
  1646.         if (!stab_xhash(ed->stab))
  1647.         hadd(ed->stab);
  1648.         if (!stab_io(ed->stab))
  1649.         stab_io(ed->stab) = stio_new();
  1650. #ifdef DEBUGGING
  1651.         if (debug & 8) {
  1652.         (void)sprintf(buf,"STAR *%s -> *%s",
  1653.             stab_name(ed->argptr.arg_stab), stab_ename(ed->argptr.arg_stab));
  1654.         ed->tmps = buf;
  1655.         }
  1656. #endif
  1657.         break;
  1658.     case A_LSTAR:
  1659.         ed->str = ed->st[++ed->sp] = (STR*)ed->argptr.arg_stab;
  1660. #ifdef DEBUGGING
  1661.         if (debug & 8) {
  1662.         (void)sprintf(buf,"LSTAR *%s -> *%s",
  1663.             stab_name(ed->argptr.arg_stab), stab_ename(ed->argptr.arg_stab));
  1664.         ed->tmps = buf;
  1665.         }
  1666. #endif
  1667.         break;
  1668.     case A_STAB:
  1669.         ed->st[++ed->sp] = STAB_STR(ed->argptr.arg_stab);
  1670. #ifdef DEBUGGING
  1671.         if (debug & 8) {
  1672.         (void)sprintf(buf,"STAB $%s",stab_name(ed->argptr.arg_stab));
  1673.         ed->tmps = buf;
  1674.         }
  1675. #endif
  1676.         break;
  1677.     case A_LENSTAB:
  1678.         str_numset(ed->str, (double)STAB_LEN(ed->argptr.arg_stab));
  1679.         ed->st[++ed->sp] = ed->str;
  1680. #ifdef DEBUGGING
  1681.         if (debug & 8) {
  1682.         (void)sprintf(buf,"LENSTAB $%s",stab_name(ed->argptr.arg_stab));
  1683.         ed->tmps = buf;
  1684.         }
  1685. #endif
  1686.         break;
  1687.     case A_LEXPR:
  1688. #ifdef DEBUGGING
  1689.         if (debug & 8) {
  1690.         ed->tmps = "LEXPR";
  1691.         deb("%d.LEXPR =>\n",ed->anum);
  1692.         }
  1693. #endif
  1694.         if (ed->argflags & AF_ARYOK) {
  1695.         ed->sp = eval(ed->argptr.arg_arg, G_ARRAY, ed->sp);
  1696.         if (ed->sp + (ed->maxarg - ed->anum) > stack->ary_max)
  1697.             astore(stack, ed->sp + (ed->maxarg - ed->anum), Nullstr);
  1698.         ed->st = stack->ary_array;    /* possibly reallocated */
  1699.         }
  1700.         else {
  1701.         ed->sp = eval(ed->argptr.arg_arg, G_SCALAR, ed->sp);
  1702.         ed->st = stack->ary_array;    /* possibly reallocated */
  1703.         ed->str = ed->st[ed->sp];
  1704.         goto do_crement;
  1705.         }
  1706.         break;
  1707.     case A_LVAL:
  1708. #ifdef DEBUGGING
  1709.         if (debug & 8) {
  1710.         (void)sprintf(buf,"LVAL $%s",stab_name(ed->argptr.arg_stab));
  1711.         ed->tmps = buf;
  1712.         }
  1713. #endif
  1714.         ++ed->sp;
  1715.         ed->str = STAB_STR(ed->argptr.arg_stab);
  1716.         if (!ed->str)
  1717.         fatal("panic: A_LVAL");
  1718.       do_crement:
  1719.         ed->assigning = TRUE;
  1720.         if (ed->argflags & AF_PRE) {
  1721.         if (ed->argflags & AF_UP)
  1722.             str_inc(ed->str);
  1723.         else
  1724.             str_dec(ed->str);
  1725.         STABSET(ed->str);
  1726.         ed->st[ed->sp] = ed->str;
  1727.         ed->str = ed->arg->arg_ptr.arg_str;
  1728.         }
  1729.         else if (ed->argflags & AF_POST) {
  1730.         ed->st[ed->sp] = str_mortal(ed->str);
  1731.         if (ed->argflags & AF_UP)
  1732.             str_inc(ed->str);
  1733.         else
  1734.             str_dec(ed->str);
  1735.         STABSET(ed->str);
  1736.         ed->str = ed->arg->arg_ptr.arg_str;
  1737.         }
  1738.         else
  1739.         ed->st[ed->sp] = ed->str;
  1740.         break;
  1741.     case A_LARYLEN:
  1742.         ++ed->sp;
  1743.         ed->stab = ed->argptr.arg_stab;
  1744.         ed->str = stab_array(ed->argptr.arg_stab)->ary_magic;
  1745.         if (ed->optype != O_SASSIGN || ed->argflags & (AF_PRE|AF_POST))
  1746.         str_numset(ed->str,(double)(stab_array(ed->stab)->ary_fill+arybase));
  1747. #ifdef DEBUGGING
  1748.         ed->tmps = "LARYLEN";
  1749. #endif
  1750.         if (!ed->str)
  1751.         fatal("panic: A_LEXPR");
  1752.         goto do_crement;
  1753.     case A_ARYLEN:
  1754.         ed->stab = ed->argptr.arg_stab;
  1755.         ed->st[++ed->sp] = stab_array(ed->stab)->ary_magic;
  1756.         str_numset(ed->st[ed->sp],(double)(stab_array(ed->stab)->ary_fill+arybase));
  1757. #ifdef DEBUGGING
  1758.         ed->tmps = "ARYLEN";
  1759. #endif
  1760.         break;
  1761.     case A_SINGLE:
  1762.         ed->st[++ed->sp] = ed->argptr.arg_str;
  1763. #ifdef DEBUGGING
  1764.         ed->tmps = "SINGLE";
  1765. #endif
  1766.         break;
  1767.     case A_DOUBLE:
  1768.         (void) interp(ed->str,ed->argptr.arg_str,ed->sp);
  1769.         ed->st = stack->ary_array;
  1770.         ed->st[++ed->sp] = ed->str;
  1771. #ifdef DEBUGGING
  1772.         ed->tmps = "DOUBLE";
  1773. #endif
  1774.         break;
  1775.     case A_BACKTICK:
  1776.         ed->tmps = str_get(interp(ed->str,ed->argptr.arg_str,ed->sp));
  1777.         ed->st = stack->ary_array;
  1778.         ed->fp = mypopen(ed->tmps,"r");
  1779.         str_set(ed->str,"");
  1780.         if (ed->fp) {
  1781.         if (ed->gimme == G_SCALAR) {
  1782.             while (str_gets(ed->str,ed->fp,ed->str->str_cur) != Nullch)
  1783.             /*SUPPRESS 530*/
  1784.             ;
  1785.         }
  1786.         else {
  1787.             for (;;) {
  1788.             if (++ed->sp > stack->ary_max) {
  1789.                 astore(stack, ed->sp, Nullstr);
  1790.                 ed->st = stack->ary_array;
  1791.             }
  1792.             ed->str = ed->st[ed->sp] = Str_new(56,80);
  1793.             if (str_gets(ed->str,ed->fp,0) == Nullch) {
  1794.                 ed->sp--;
  1795.                 break;
  1796.             }
  1797.             if (ed->str->str_len - ed->str->str_cur > 20) {
  1798.                 ed->str->str_len = ed->str->str_cur+1;
  1799.                 Renew(ed->str->str_ptr, ed->str->str_len, char);
  1800.             }
  1801.             str_2mortal(ed->str);
  1802.             }
  1803.         }
  1804.         statusvalue = mypclose(ed->fp);
  1805.         }
  1806.         else
  1807.         statusvalue = -1;
  1808.  
  1809.         if (ed->gimme == G_SCALAR)
  1810.         ed->st[++ed->sp] = ed->str;
  1811. #ifdef DEBUGGING
  1812.         ed->tmps = "BACK";
  1813. #endif
  1814.         break;
  1815.     case A_WANTARRAY:
  1816.         {
  1817.         if (curcsv->wantarray == G_ARRAY)
  1818.             ed->st[++ed->sp] = &str_yes;
  1819.         else
  1820.             ed->st[++ed->sp] = &str_no;
  1821.         }
  1822. #ifdef DEBUGGING
  1823.         ed->tmps = "WANTARRAY";
  1824. #endif
  1825.         break;
  1826.     case A_INDREAD:
  1827.         last_in_stab = stabent(str_get(STAB_STR(ed->argptr.arg_stab)),TRUE);
  1828.         old_rschar = rschar;
  1829.         old_rslen = rslen;
  1830.         goto do_read;
  1831.     case A_GLOB:
  1832.         ed->argflags |= AF_POST;    /* enable newline chopping */
  1833.         last_in_stab = ed->argptr.arg_stab;
  1834.         old_rschar = rschar;
  1835.         old_rslen = rslen;
  1836.         rslen = 1;
  1837.         rschar = '\n';
  1838.         goto do_read;
  1839.     case A_READ:
  1840.         last_in_stab = ed->argptr.arg_stab;
  1841.         old_rschar = rschar;
  1842.         old_rslen = rslen;
  1843.       do_read:
  1844.         if (ed->anum > 1)        /* assign to scalar */
  1845.         ed->gimme = G_SCALAR;    /* force context to scalar */
  1846.         if (ed->gimme == G_ARRAY)
  1847.         ed->str = Str_new(57,0);
  1848.         ++ed->sp;
  1849.         ed->fp = Nullfp;
  1850.         if (stab_io(last_in_stab)) {
  1851.         ed->fp = stab_io(last_in_stab)->ifp;
  1852.         if (!ed->fp) {
  1853.             if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  1854.             if (stab_io(last_in_stab)->flags & IOF_START) {
  1855.                 stab_io(last_in_stab)->flags &= ~IOF_START;
  1856.                 stab_io(last_in_stab)->lines = 0;
  1857.                 if (alen(stab_array(last_in_stab)) < 0) {
  1858.                 ed->tmpstr = str_make("-",1); /* assume stdin */
  1859.                 (void)apush(stab_array(last_in_stab), ed->tmpstr);
  1860.                 }
  1861.             }
  1862.             ed->fp = nextargv(last_in_stab);
  1863.             if (!ed->fp) { /* Note: ed->fp != stab_io(last_in_stab)->ifp */
  1864.                 (void)do_close(last_in_stab,FALSE); /* now it does*/
  1865.                 stab_io(last_in_stab)->flags |= IOF_START;
  1866.             }
  1867.             }
  1868.             else if (ed->argtype == A_GLOB) {
  1869.             (void) interp(ed->str,stab_val(last_in_stab),ed->sp);
  1870.             ed->st = stack->ary_array;
  1871.             ed->tmpstr = Str_new(55,0);
  1872.             str_set(ed->tmpstr, "For i in ");
  1873.             str_scat(ed->tmpstr, ed->str);
  1874.             str_cat(ed->tmpstr,"; echo \"{i}\"; end |");
  1875.             (void)do_open(last_in_stab,ed->tmpstr->str_ptr,
  1876.               ed->tmpstr->str_cur);
  1877.             ed->fp = stab_io(last_in_stab)->ifp;
  1878.             str_free(ed->tmpstr);
  1879.             }
  1880.         }
  1881.         }
  1882.         if (!ed->fp && dowarn)
  1883.         warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
  1884.         ed->tmplen = ed->str->str_len;    /* remember if already alloced */
  1885.         if (!ed->tmplen)
  1886.         Str_Grow(ed->str,80);    /* try short-buffering it */
  1887.       keepgoing:
  1888.         if (!ed->fp)
  1889.         ed->st[ed->sp] = &str_undef;
  1890.         else if (!str_gets(ed->str,ed->fp, ed->optype == O_RCAT ? ed->str->str_cur : 0)) {
  1891.         clearerr(ed->fp);
  1892.         if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  1893.             ed->fp = nextargv(last_in_stab);
  1894.             if (ed->fp)
  1895.             goto keepgoing;
  1896.             (void)do_close(last_in_stab,FALSE);
  1897.             stab_io(last_in_stab)->flags |= IOF_START;
  1898.         }
  1899.         else if (ed->argflags & AF_POST) {
  1900.             (void)do_close(last_in_stab,FALSE);
  1901.         }
  1902.         ed->st[ed->sp] = &str_undef;
  1903.         rschar = old_rschar;
  1904.         rslen = old_rslen;
  1905.         if (ed->gimme == G_ARRAY) {
  1906.             --ed->sp;
  1907.             str_2mortal(ed->str);
  1908.             goto array_return;
  1909.         }
  1910.         break;
  1911.         }
  1912.         else {
  1913.         stab_io(last_in_stab)->lines++;
  1914.         ed->st[ed->sp] = ed->str;
  1915.         if (ed->argflags & AF_POST) {
  1916.             if (ed->str->str_cur > 0)
  1917.             ed->str->str_cur--;
  1918.             if (ed->str->str_ptr[ed->str->str_cur] == rschar)
  1919.             ed->str->str_ptr[ed->str->str_cur] = '\0';
  1920.             else
  1921.             ed->str->str_cur++;
  1922.             for (ed->tmps = ed->str->str_ptr; *ed->tmps; ed->tmps++)
  1923.             if (!isALPHA(*ed->tmps) && !isDIGIT(*ed->tmps) &&
  1924.                 index("$&*(){}[]'\";\\|?<>~`",*ed->tmps))
  1925.                 break;
  1926.             if (*ed->tmps && stat(ed->str->str_ptr,&statbuf) < 0)
  1927.             goto keepgoing;        /* unmatched wildcard? */
  1928.         }
  1929.         if (ed->gimme == G_ARRAY) {
  1930.             if (ed->str->str_len - ed->str->str_cur > 20) {
  1931.             ed->str->str_len = ed->str->str_cur+1;
  1932.             Renew(ed->str->str_ptr, ed->str->str_len, char);
  1933.             }
  1934.             str_2mortal(ed->str);
  1935.             if (++ed->sp > stack->ary_max) {
  1936.             astore(stack, ed->sp, Nullstr);
  1937.             ed->st = stack->ary_array;
  1938.             }
  1939.             ed->str = Str_new(58,80);
  1940.             goto keepgoing;
  1941.         }
  1942.         else if (!ed->tmplen && ed->str->str_len - ed->str->str_cur > 80) {
  1943.             /* try to reclaim a bit of scalar space on 1st alloc */
  1944.             if (ed->str->str_cur < 60)
  1945.             ed->str->str_len = 80;
  1946.             else
  1947.             ed->str->str_len = ed->str->str_cur+40;    /* allow some slop */
  1948.             Renew(ed->str->str_ptr, ed->str->str_len, char);
  1949.         }
  1950.         }
  1951.         rschar = old_rschar;
  1952.         rslen = old_rslen;
  1953. #ifdef DEBUGGING
  1954.         ed->tmps = "READ";
  1955. #endif
  1956.         break;
  1957.     }
  1958. #ifdef DEBUGGING
  1959.     if (debug & 8)
  1960.         deb("%d.%s = '%s'\n",ed->anum,ed->tmps,str_peek(ed->st[ed->sp]));
  1961. #endif
  1962.     if (ed->anum < 8)
  1963.         ed->arglast[ed->anum] = ed->sp;
  1964.     }
  1965.  
  1966.     ed->st += ed->arglast[0];
  1967.     if (ed->optype < O_PACK)
  1968.         switch (eval1(ed)) {
  1969.         case R_nojump:
  1970.             break;
  1971.         case R_array_return:
  1972.             goto array_return;
  1973.         case R_say_no:
  1974.             goto say_no;
  1975.         case R_re_eval:
  1976.             goto re_eval;
  1977. #ifndef HAS_SOCKET
  1978.         case R_badsock:
  1979.             goto badsock;
  1980. #endif
  1981.         case R_say_yes:
  1982.             goto say_yes;
  1983.         case R_say_undef:
  1984.             goto say_undef;
  1985.         case R_donumset:
  1986.             goto donumset;
  1987.         case R_say_zero:
  1988.             goto say_zero;
  1989.         default:
  1990.             fatal("\pOops !");
  1991.         }
  1992.     else if (ed->optype < O_CHOWN)
  1993.         switch (eval2(ed)) {
  1994.         case R_nojump:
  1995.             break;
  1996.         case R_array_return:
  1997.             goto array_return;
  1998.         case R_say_no:
  1999.             goto say_no;
  2000.         case R_re_eval:
  2001.             goto re_eval;
  2002. #ifndef HAS_SOCKET
  2003.         case R_badsock:
  2004.             goto badsock;
  2005. #endif
  2006.         case R_say_yes:
  2007.             goto say_yes;
  2008.         case R_say_undef:
  2009.             goto say_undef;
  2010.         case R_donumset:
  2011.             goto donumset;
  2012.         case R_say_zero:
  2013.             goto say_zero;
  2014.         default:
  2015.             fatal("\pOops !");
  2016.         }
  2017.     else
  2018.     switch (ed->optype) {
  2019.     case O_CHOWN:
  2020. #ifdef HAS_CHOWN
  2021.     ed->value = (double)apply(ed->optype,ed->arglast);
  2022.     goto donumset;
  2023. #else
  2024.     fatal("Unsupported function chown");
  2025.     break;
  2026. #endif
  2027.     case O_KILL:
  2028.     fatal("Unsupported function kill");
  2029.     break;
  2030.     case O_UNLINK:
  2031.     case O_CHMOD:
  2032.     case O_UTIME:
  2033.     ed->value = (double)apply(ed->optype,ed->arglast);
  2034.     goto donumset;
  2035.     case O_UMASK:
  2036.     fatal("Unsupported function umask");
  2037.     break;
  2038. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  2039.     case O_MSGGET:
  2040.     case O_SHMGET:
  2041.     case O_SEMGET:
  2042.     if ((ed->anum = do_ipcget(ed->optype, ed->arglast)) == -1)
  2043.         goto say_undef;
  2044.     ed->value = (double)ed->anum;
  2045.     goto donumset;
  2046.     case O_MSGCTL:
  2047.     case O_SHMCTL:
  2048.     case O_SEMCTL:
  2049.     ed->anum = do_ipcctl(ed->optype, ed->arglast);
  2050.     if (ed->anum == -1)
  2051.         goto say_undef;
  2052.     if (ed->anum != 0) {
  2053.         ed->value = (double)ed->anum;
  2054.         goto donumset;
  2055.     }
  2056.     str_set(ed->str,"0 but true");
  2057.     STABSET(ed->str);
  2058.     break;
  2059.     case O_MSGSND:
  2060.     ed->value = (double)(do_msgsnd(ed->arglast) >= 0);
  2061.     goto donumset;
  2062.     case O_MSGRCV:
  2063.     ed->value = (double)(do_msgrcv(ed->arglast) >= 0);
  2064.     goto donumset;
  2065.     case O_SEMOP:
  2066.     ed->value = (double)(do_semop(ed->arglast) >= 0);
  2067.     goto donumset;
  2068.     case O_SHMREAD:
  2069.     case O_SHMWRITE:
  2070.     ed->value = (double)(do_shmio(ed->optype, ed->arglast) >= 0);
  2071.     goto donumset;
  2072. #else /* not SYSVIPC */
  2073.     case O_MSGGET:
  2074.     case O_MSGCTL:
  2075.     case O_MSGSND:
  2076.     case O_MSGRCV:
  2077.     case O_SEMGET:
  2078.     case O_SEMCTL:
  2079.     case O_SEMOP:
  2080.     case O_SHMGET:
  2081.     case O_SHMCTL:
  2082.     case O_SHMREAD:
  2083.     case O_SHMWRITE:
  2084.     fatal("System V IPC is not implemented on this machine");
  2085. #endif /* not SYSVIPC */
  2086.     case O_RENAME:
  2087.     ed->tmps = str_get(ed->st[1]);
  2088.     ed->tmps2 = str_get(ed->st[2]);
  2089.     ed->value = (double)(rename(ed->tmps,ed->tmps2) >= 0);
  2090.     goto donumset;
  2091.     case O_LINK:
  2092.     fatal("Unsupported function link");
  2093.     break;
  2094.     case O_MKDIR:
  2095.     ed->tmps = str_get(ed->st[1]);
  2096.     ed->anum = (int)str_gnum(ed->st[2]);
  2097.     ed->value = (double)(mkdir(ed->tmps) >= 0);
  2098.     goto donumset;
  2099.     case O_RMDIR:
  2100.     if (ed->maxarg < 1)
  2101.         ed->tmps = str_get(stab_val(defstab));
  2102.     else
  2103.         ed->tmps = str_get(ed->st[1]);
  2104.     ed->value = (double)(rmdir(ed->tmps) >= 0);
  2105.     goto donumset;
  2106.     case O_GETPPID:
  2107.     fatal("Unsupported function getppid");
  2108.     break;
  2109.     case O_GETPGRP:
  2110.     fatal("The getpgrp() function is unimplemented on this machine");
  2111.     break;
  2112.     case O_SETPGRP:
  2113.     fatal("The setpgrp() function is unimplemented on this machine");
  2114.     break;
  2115.     case O_GETPRIORITY:
  2116.     fatal("The getpriority() function is unimplemented on this machine");
  2117.     break;
  2118.     case O_SETPRIORITY:
  2119.     fatal("The setpriority() function is unimplemented on this machine");
  2120.     break;
  2121.     case O_CHROOT:
  2122.     fatal("Unsupported function chroot");
  2123.     break;
  2124.     case O_FCNTL:
  2125.     case O_IOCTL:
  2126.     if (ed->maxarg <= 0)
  2127.         ed->stab = last_in_stab;
  2128.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2129.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2130.     else
  2131.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2132.     ed->argtype = U_I(str_gnum(ed->st[2]));
  2133.     ed->anum = do_ctl(ed->optype,ed->stab,ed->argtype,ed->st[3]);
  2134.     if (ed->anum == -1)
  2135.         goto say_undef;
  2136.     if (ed->anum != 0) {
  2137.         ed->value = (double)ed->anum;
  2138.         goto donumset;
  2139.     }
  2140.     str_set(ed->str,"0 but true");
  2141.     STABSET(ed->str);
  2142.     break;
  2143.     case O_FLOCK:
  2144. #ifdef HAS_FLOCK
  2145.     if (ed->maxarg <= 0)
  2146.         ed->stab = last_in_stab;
  2147.     else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2148.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2149.     else
  2150.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2151.     if (ed->stab && stab_io(ed->stab))
  2152.         ed->fp = stab_io(ed->stab)->ifp;
  2153.     else
  2154.         ed->fp = Nullfp;
  2155.     if (ed->fp) {
  2156.         ed->argtype = (int)str_gnum(ed->st[2]);
  2157.         ed->value = (double)(flock(fileno(ed->fp),ed->argtype) >= 0);
  2158.     }
  2159.     else
  2160.         ed->value = 0;
  2161.     goto donumset;
  2162. #else
  2163.     fatal("The flock() function is unimplemented on this machine");
  2164.     break;
  2165. #endif
  2166.     case O_UNSHIFT:
  2167.     ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab);
  2168.     if (ed->arglast[2] - ed->arglast[1] != 1)
  2169.         do_unshift(ed->ary,ed->arglast);
  2170.     else {
  2171.         STR *    tmpstr = Str_new(52,0);    /* must copy the ed->str */
  2172.         str_sset(tmpstr,ed->st[2]);
  2173.         aunshift(ed->ary,1);
  2174.         (void)astore(ed->ary,0,tmpstr);
  2175.     }
  2176.     ed->value = (double)(ed->ary->ary_fill + 1);
  2177.     goto donumset;
  2178.  
  2179.     case O_TRY:
  2180.     sp = do_try(ed->arg[1].arg_ptr.arg_cmd,
  2181.         ed->gimme,ed->arglast);
  2182.     goto array_return;
  2183.  
  2184.     case O_EVALONCE:
  2185.     sp = do_eval(ed->st[1], O_EVAL, curcmd->c_stash, TRUE,
  2186.         ed->gimme,ed->arglast);
  2187.     if (eval_root) {
  2188.         str_free(ed->arg[1].arg_ptr.arg_str);
  2189.         ed->arg[1].arg_ptr.arg_cmd = eval_root;
  2190.         ed->arg[1].arg_type = (A_CMD|A_DONT);
  2191.         ed->arg[0].arg_type = O_TRY;
  2192.     }
  2193.     goto array_return;
  2194.  
  2195.     case O_REQUIRE:
  2196.     case O_DOFILE:
  2197.     case O_EVAL:
  2198.     if (ed->maxarg < 1)
  2199.         ed->tmpstr = stab_val(defstab);
  2200.     else
  2201.         ed->tmpstr =
  2202.           (ed->arg[1].arg_type & A_MASK) != A_NULL ? ed->st[1] : stab_val(defstab);
  2203.     ed->sp = do_eval(ed->tmpstr, ed->optype, curcmd->c_stash, FALSE,
  2204.         ed->gimme,ed->arglast);
  2205.     goto array_return;
  2206.  
  2207.     case O_FTRREAD:
  2208.     ed->argtype = 0;
  2209.     ed->anum = S_IRUSR;
  2210.     goto check_perm;
  2211.     case O_FTRWRITE:
  2212.     ed->argtype = 0;
  2213.     ed->anum = S_IWUSR;
  2214.     goto check_perm;
  2215.     case O_FTREXEC:
  2216.     ed->argtype = 0;
  2217.     ed->anum = S_IXUSR;
  2218.     goto check_perm;
  2219.     case O_FTEREAD:
  2220.     ed->argtype = 1;
  2221.     ed->anum = S_IRUSR;
  2222.     goto check_perm;
  2223.     case O_FTEWRITE:
  2224.     ed->argtype = 1;
  2225.     ed->anum = S_IWUSR;
  2226.     goto check_perm;
  2227.     case O_FTEEXEC:
  2228.     ed->argtype = 1;
  2229.     ed->anum = S_IXUSR;
  2230.       check_perm:
  2231.     if (mystat(ed->arg,ed->st[1]) < 0)
  2232.         goto say_undef;
  2233.     if (cando(ed->anum,ed->argtype,&statcache))
  2234.         goto say_yes;
  2235.     goto say_no;
  2236.  
  2237.     case O_FTIS:
  2238.     if (mystat(ed->arg,ed->st[1]) < 0)
  2239.         goto say_undef;
  2240.     goto say_yes;
  2241.     case O_FTEOWNED:
  2242.     case O_FTROWNED:
  2243.     if (mystat(ed->arg,ed->st[1]) < 0)
  2244.         goto say_undef;
  2245.     else
  2246.         goto say_yes;
  2247.     case O_FTZERO:
  2248.     if (mystat(ed->arg,ed->st[1]) < 0)
  2249.         goto say_undef;
  2250.     if (!statcache.st_size)
  2251.         goto say_yes;
  2252.     goto say_no;
  2253.     case O_FTSIZE:
  2254.     if (mystat(ed->arg,ed->st[1]) < 0)
  2255.         goto say_undef;
  2256.     ed->value = (double)statcache.st_size;
  2257.     goto donumset;
  2258.  
  2259.     case O_FTMTIME:
  2260.     if (mystat(ed->arg,ed->st[1]) < 0)
  2261.         goto say_undef;
  2262.     ed->value = (double)(basetime - statcache.st_mtime) / 86400.0;
  2263.     goto donumset;
  2264.     case O_FTATIME:
  2265.     if (mystat(ed->arg,ed->st[1]) < 0)
  2266.         goto say_undef;
  2267.     ed->value = (double)(basetime - statcache.st_atime) / 86400.0;
  2268.     goto donumset;
  2269.     case O_FTCTIME:
  2270.     if (mystat(ed->arg,ed->st[1]) < 0)
  2271.         goto say_undef;
  2272.     ed->value = (double)(basetime - statcache.st_ctime) / 86400.0;
  2273.     goto donumset;
  2274.  
  2275.     case O_FTSOCK:
  2276.     if (mystat(ed->arg,ed->st[1]) < 0)
  2277.         goto say_undef;
  2278.     if (S_ISSOCK(statcache.st_mode))
  2279.         goto say_yes;
  2280.     goto say_no;
  2281.     case O_FTCHR:
  2282.     if (mystat(ed->arg,ed->st[1]) < 0)
  2283.         goto say_undef;
  2284.     if (S_ISCHR(statcache.st_mode))
  2285.         goto say_yes;
  2286.     goto say_no;
  2287.     case O_FTBLK:
  2288.     if (mystat(ed->arg,ed->st[1]) < 0)
  2289.         goto say_undef;
  2290.     if (S_ISBLK(statcache.st_mode))
  2291.         goto say_yes;
  2292.     goto say_no;
  2293.     case O_FTFILE:
  2294.     if (mystat(ed->arg,ed->st[1]) < 0)
  2295.         goto say_undef;
  2296.     if (S_ISREG(statcache.st_mode))
  2297.         goto say_yes;
  2298.     goto say_no;
  2299.     case O_FTDIR:
  2300.     if (mystat(ed->arg,ed->st[1]) < 0)
  2301.         goto say_undef;
  2302.     if (S_ISDIR(statcache.st_mode))
  2303.         goto say_yes;
  2304.     goto say_no;
  2305.     case O_FTPIPE:
  2306.     if (mystat(ed->arg,ed->st[1]) < 0)
  2307.         goto say_undef;
  2308.     if (S_ISFIFO(statcache.st_mode))
  2309.         goto say_yes;
  2310.     goto say_no;
  2311.     case O_FTLINK:
  2312.     if (mylstat(ed->arg,ed->st[1]) < 0)
  2313.         goto say_undef;
  2314.     if (S_ISLNK(statcache.st_mode))
  2315.         goto say_yes;
  2316.     goto say_no;
  2317.     case O_SYMLINK:
  2318. #ifdef HAS_SYMLINK
  2319.     ed->tmps = str_get(ed->st[1]);
  2320.     ed->tmps2 = str_get(ed->st[2]);
  2321.     ed->value = (double)(symlink(ed->tmps,ed->tmps2) >= 0);
  2322.     goto donumset;
  2323. #else
  2324.     fatal("Unsupported function symlink");
  2325. #endif
  2326.     case O_READLINK:
  2327. #ifdef HAS_SYMLINK
  2328.     if (ed->maxarg < 1)
  2329.         ed->tmps = str_get(stab_val(defstab));
  2330.     else
  2331.         ed->tmps = str_get(ed->st[1]);
  2332.     ed->anum = readlink(ed->tmps,buf,sizeof buf);
  2333.     if (ed->anum < 0)
  2334.         goto say_undef;
  2335.     str_nset(ed->str,buf,ed->anum);
  2336.     break;
  2337. #else
  2338.     goto say_undef;        /* just pretend it's a normal file */
  2339. #endif
  2340.     case O_FTSUID:
  2341. #ifdef S_ISUID
  2342.     ed->anum = S_ISUID;
  2343.     goto check_xid;
  2344. #else
  2345.     goto say_no;
  2346. #endif
  2347.     case O_FTSGID:
  2348. #ifdef S_ISGID
  2349.     ed->anum = S_ISGID;
  2350.     goto check_xid;
  2351. #else
  2352.     goto say_no;
  2353. #endif
  2354.     case O_FTSVTX:
  2355. #ifdef S_ISVTX
  2356.     ed->anum = S_ISVTX;
  2357. #else
  2358.     goto say_no;
  2359. #endif
  2360.       check_xid:
  2361.     if (mystat(ed->arg,ed->st[1]) < 0)
  2362.         goto say_undef;
  2363.     if (statcache.st_mode & ed->anum)
  2364.         goto say_yes;
  2365.     goto say_no;
  2366.     case O_FTTTY:
  2367.     if (ed->arg[1].arg_type & A_DONT) {
  2368.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2369.         ed->tmps = "";
  2370.     }
  2371.     else
  2372.         ed->stab = stabent(ed->tmps = str_get(ed->st[1]),FALSE);
  2373.     if (ed->stab && stab_io(ed->stab) && stab_io(ed->stab)->ifp)
  2374.         ed->anum = fileno(stab_io(ed->stab)->ifp);
  2375.     else if (isDIGIT(*ed->tmps))
  2376.         ed->anum = atoi(ed->tmps);
  2377.     else
  2378.         goto say_undef;
  2379.     if (isatty(ed->anum))
  2380.         goto say_yes;
  2381.     goto say_no;
  2382.     case O_FTTEXT:
  2383.     case O_FTBINARY:
  2384.     ed->str = do_fttext(ed->arg,ed->st[1]);
  2385.     break;
  2386. #ifdef HAS_SOCKET
  2387.     case O_SOCKET:
  2388.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2389.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2390.     else
  2391.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2392.     ed->value = (double)do_socket(ed->stab,ed->arglast);
  2393.     goto donumset;
  2394.     case O_BIND:
  2395.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2396.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2397.     else
  2398.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2399.     ed->value = (double)do_bind(ed->stab,ed->arglast);
  2400.     goto donumset;
  2401.     case O_CONNECT:
  2402.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2403.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2404.     else
  2405.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2406.     ed->value = (double)do_connect(ed->stab,ed->arglast);
  2407.     goto donumset;
  2408.     case O_LISTEN:
  2409.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2410.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2411.     else
  2412.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2413.     ed->value = (double)do_listen(ed->stab,ed->arglast);
  2414.     goto donumset;
  2415.     case O_ACCEPT:
  2416.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2417.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2418.     else
  2419.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2420.     if ((ed->arg[2].arg_type & A_MASK) == A_WORD)
  2421.         stab2 = ed->arg[2].arg_ptr.arg_stab;
  2422.     else
  2423.         stab2 = stabent(str_get(ed->st[2]),TRUE);
  2424.     do_accept(ed->str,ed->stab,stab2);
  2425.     STABSET(ed->str);
  2426.     break;
  2427.     case O_GHBYNAME:
  2428.     if (ed->maxarg < 1)
  2429.         goto say_undef;
  2430.     case O_GHBYADDR:
  2431.     case O_GHOSTENT:
  2432.     ed->sp = do_ghent(ed->optype,
  2433.       ed->gimme,ed->arglast);
  2434.     goto array_return;
  2435. #ifndef macintosh
  2436.     case O_GNBYNAME:
  2437.     if (ed->maxarg < 1)
  2438.         goto say_undef;
  2439.     case O_GNBYADDR:
  2440.     case O_GNETENT:
  2441.     ed->sp = do_gnent(ed->optype,
  2442.       ed->gimme,ed->arglast);
  2443.     goto array_return;
  2444. #else
  2445.     case O_GNBYNAME:
  2446.     case O_GNBYADDR:
  2447.     case O_GNETENT:
  2448.     fatal("getnet…() not implemented");
  2449. #endif
  2450.     case O_GPBYNAME:
  2451.     if (ed->maxarg < 1)
  2452.         goto say_undef;
  2453.     case O_GPBYNUMBER:
  2454.     case O_GPROTOENT:
  2455.     ed->sp = do_gpent(ed->optype,
  2456.       ed->gimme,ed->arglast);
  2457.     goto array_return;
  2458.     case O_GSBYNAME:
  2459.     if (ed->maxarg < 1)
  2460.         goto say_undef;
  2461.     case O_GSBYPORT:
  2462.     case O_GSERVENT:
  2463.     ed->sp = do_gsent(ed->optype,
  2464.       ed->gimme,ed->arglast);
  2465.     goto array_return;
  2466. #ifndef macintosh
  2467.     case O_SHOSTENT:
  2468.     ed->value = (double) sethostent((int)str_gnum(ed->st[1]));
  2469.     goto donumset;
  2470.     case O_SNETENT:
  2471.     ed->value = (double) setnetent((int)str_gnum(ed->st[1]));
  2472.     goto donumset;
  2473.     case O_SPROTOENT:
  2474.     ed->value = (double) setprotoent((int)str_gnum(ed->st[1]));
  2475.     goto donumset;
  2476.     case O_SSERVENT:
  2477.     ed->value = (double) setservent((int)str_gnum(ed->st[1]));
  2478.     goto donumset;
  2479. #else
  2480.     case O_SHOSTENT:
  2481.     case O_SNETENT:
  2482.     case O_SPROTOENT:
  2483.     case O_SSERVENT:
  2484.     fatal("set…() not implemented");
  2485. #endif
  2486. #ifndef macintosh
  2487.     case O_EHOSTENT:
  2488.     ed->value = (double) endhostent();
  2489.     goto donumset;
  2490.     case O_ENETENT:
  2491.     ed->value = (double) endnetent();
  2492.     goto donumset;
  2493.     case O_EPROTOENT:
  2494.     ed->value = (double) endprotoent();
  2495.     goto donumset;
  2496.     case O_ESERVENT:
  2497.     ed->value = (double) endservent();
  2498.     goto donumset;
  2499. #else
  2500.     case O_EHOSTENT:
  2501.     case O_ENETENT:
  2502.     case O_EPROTOENT:
  2503.     case O_ESERVENT:
  2504.     fatal("end…() not implemented");
  2505. #endif
  2506. #ifndef macintosh
  2507.     case O_SOCKPAIR:
  2508.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2509.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2510.     else
  2511.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2512.     if ((ed->arg[2].arg_type & A_MASK) == A_WORD)
  2513.         stab2 = ed->arg[2].arg_ptr.arg_stab;
  2514.     else
  2515.         stab2 = stabent(str_get(ed->st[2]),TRUE);
  2516.     ed->value = (double)do_spair(ed->stab,stab2,ed->arglast);
  2517.     goto donumset;
  2518. #else
  2519.     case O_SOCKPAIR:
  2520.         fatal("socketpair() not implemented");
  2521. #endif
  2522.     case O_SHUTDOWN:
  2523.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2524.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2525.     else
  2526.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2527.     ed->value = (double)do_shutdown(ed->stab,ed->arglast);
  2528.     goto donumset;
  2529.     case O_GSOCKOPT:
  2530.     case O_SSOCKOPT:
  2531.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2532.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2533.     else
  2534.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2535.     ed->sp = do_sopt(ed->optype,ed->stab,ed->arglast);
  2536.     goto array_return;
  2537.     case O_GETSOCKNAME:
  2538.     case O_GETPEERNAME:
  2539.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2540.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2541.     else
  2542.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2543.     if (!ed->stab)
  2544.         goto say_undef;
  2545.     ed->sp = do_getsockname(ed->optype,ed->stab,ed->arglast);
  2546.     goto array_return;
  2547.  
  2548. #ifdef macintosh
  2549.     case O_CHOOSE:
  2550.     ed->str = do_choose(ed->arglast, ed->maxarg);
  2551.     break;
  2552. #endif
  2553.  
  2554. #else /* HAS_SOCKET not defined */
  2555.     case O_SOCKET:
  2556.     case O_BIND:
  2557.     case O_CONNECT:
  2558.     case O_LISTEN:
  2559.     case O_ACCEPT:
  2560.     case O_SOCKPAIR:
  2561.     case O_GHBYNAME:
  2562.     case O_GHBYADDR:
  2563.     case O_GHOSTENT:
  2564.     case O_GNBYNAME:
  2565.     case O_GNBYADDR:
  2566.     case O_GNETENT:
  2567.     case O_GPBYNAME:
  2568.     case O_GPBYNUMBER:
  2569.     case O_GPROTOENT:
  2570.     case O_GSBYNAME:
  2571.     case O_GSBYPORT:
  2572.     case O_GSERVENT:
  2573.     case O_SHOSTENT:
  2574.     case O_SNETENT:
  2575.     case O_SPROTOENT:
  2576.     case O_SSERVENT:
  2577.     case O_EHOSTENT:
  2578.     case O_ENETENT:
  2579.     case O_EPROTOENT:
  2580.     case O_ESERVENT:
  2581.     case O_SHUTDOWN:
  2582.     case O_GSOCKOPT:
  2583.     case O_SSOCKOPT:
  2584.     case O_GETSOCKNAME:
  2585.     case O_GETPEERNAME:
  2586.       badsock:
  2587.     fatal("Unsupported socket function");
  2588. #endif /* HAS_SOCKET */
  2589.     case O_SSELECT:
  2590. #ifdef HAS_SELECT
  2591.     ed->sp = do_select(ed->gimme,ed->arglast);
  2592.     goto array_return;
  2593. #else
  2594.     fatal("select not implemented");
  2595. #endif
  2596.     case O_FILENO:
  2597.     if (ed->maxarg < 1)
  2598.         goto say_undef;
  2599.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2600.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2601.     else
  2602.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2603.     if (!ed->stab || !(stio = stab_io(ed->stab)) || !(ed->fp = stio->ifp))
  2604.         goto say_undef;
  2605.     ed->value = fileno(ed->fp);
  2606.     goto donumset;
  2607.     case O_BINMODE:
  2608.     if (ed->maxarg < 1)
  2609.         goto say_undef;
  2610.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2611.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2612.     else
  2613.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2614.     if (!ed->stab || !(stio = stab_io(ed->stab)) || !(ed->fp = stio->ifp))
  2615.         goto say_undef;
  2616.     str_set(ed->str, Yes);
  2617.     STABSET(ed->str);
  2618.     break;
  2619.     case O_VEC:
  2620.     ed->sp = do_vec(ed->str == ed->st[1], ed->arg->arg_ptr.arg_str, ed->arglast);
  2621.     goto array_return;
  2622.     case O_GPWNAM:
  2623.     case O_GPWUID:
  2624.     case O_GPWENT:
  2625. #ifdef HAS_PASSWD
  2626.     ed->sp = do_gpwent(ed->optype,
  2627.       ed->gimme,ed->arglast);
  2628.     goto array_return;
  2629.     case O_SPWENT:
  2630.     ed->value = (double) setpwent();
  2631.     goto donumset;
  2632.     case O_EPWENT:
  2633.     ed->value = (double) endpwent();
  2634.     goto donumset;
  2635. #else
  2636.     case O_EPWENT:
  2637.     case O_SPWENT:
  2638.     fatal("Unsupported password function");
  2639.     break;
  2640. #endif
  2641.     case O_GGRNAM:
  2642.     case O_GGRGID:
  2643.     case O_GGRENT:
  2644. #ifdef HAS_GROUP
  2645.     ed->sp = do_ggrent(ed->optype,
  2646.       ed->gimme,ed->arglast);
  2647.     goto array_return;
  2648.     case O_SGRENT:
  2649.     ed->value = (double) setgrent();
  2650.     goto donumset;
  2651.     case O_EGRENT:
  2652.     ed->value = (double) endgrent();
  2653.     goto donumset;
  2654. #else
  2655.     case O_EGRENT:
  2656.     case O_SGRENT:
  2657.     fatal("Unsupported group function");
  2658.     break;
  2659. #endif
  2660.     case O_GETLOGIN:
  2661. #ifdef HAS_GETLOGIN
  2662.     if (!(ed->tmps = getlogin()))
  2663.         goto say_undef;
  2664.     str_set(ed->str,ed->tmps);
  2665. #else
  2666.     fatal("Unsupported function getlogin");
  2667. #endif
  2668.     break;
  2669.     case O_OPEN_DIR:
  2670.     case O_READDIR:
  2671.     case O_TELLDIR:
  2672.     case O_SEEKDIR:
  2673.     case O_REWINDDIR:
  2674.     case O_CLOSEDIR:
  2675.     if (ed->maxarg < 1)
  2676.         goto say_undef;
  2677.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2678.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2679.     else
  2680.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2681.     if (!ed->stab)
  2682.         goto say_undef;
  2683.     ed->sp = do_dirop(ed->optype,ed->stab,ed->gimme,ed->arglast);
  2684.     goto array_return;
  2685.     case O_SYSCALL:
  2686.     ed->value = (double)do_syscall(ed->arglast);
  2687.     goto donumset;
  2688.     case O_PIPE_OP:
  2689. #ifdef HAS_PIPE
  2690.     if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
  2691.         ed->stab = ed->arg[1].arg_ptr.arg_stab;
  2692.     else
  2693.         ed->stab = stabent(str_get(ed->st[1]),TRUE);
  2694.     if ((ed->arg[2].arg_type & A_MASK) == A_WORD)
  2695.         stab2 = ed->arg[2].arg_ptr.arg_stab;
  2696.     else
  2697.         stab2 = stabent(str_get(ed->st[2]),TRUE);
  2698.     do_pipe(ed->str,ed->stab,stab2);
  2699.     STABSET(ed->str);
  2700. #else
  2701.     fatal("Unsupported function pipe");
  2702. #endif
  2703.     break;
  2704. #ifdef macintosh
  2705.     case O_ASK:
  2706.     ed->str = do_ask(ed->arglast, ed->maxarg);
  2707.     break;
  2708.     case O_ANSWER:
  2709.     ed->value = do_answer(ed->arglast);
  2710.     goto donumset;
  2711.     case O_PICK:
  2712.     ed->str = do_pick(ed->arglast);
  2713.     break;
  2714. #endif
  2715.     }
  2716.  
  2717.   normal_return:
  2718.     ed->st[1] = ed->str;
  2719. #ifdef DEBUGGING
  2720.     if (debug) {
  2721.     dlevel--;
  2722.     if (debug & 8)
  2723.         deb("%s RETURNS \"%s\"\n",opname[ed->optype],str_get(ed->str));
  2724.     }
  2725. #endif
  2726.     return ed->arglast[0] + 1;
  2727.  
  2728. array_return:
  2729. #ifdef DEBUGGING
  2730.     if (debug) {
  2731.     dlevel--;
  2732.     if (debug & 8) {
  2733.         ed->anum = ed->sp - ed->arglast[0];
  2734.         switch (ed->anum) {
  2735.         case 0:
  2736.         deb("%s RETURNS ()\n",opname[ed->optype]);
  2737.         break;
  2738.         case 1:
  2739.         deb("%s RETURNS (\"%s\")\n",opname[ed->optype],
  2740.             ed->st[1] ? str_get(ed->st[1]) : "");
  2741.         break;
  2742.         default:
  2743.         ed->tmps = ed->st[1] ? str_get(ed->st[1]) : "";
  2744.         deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[ed->optype],
  2745.           ed->anum,ed->tmps,ed->anum==2?"":"...,",
  2746.             ed->st[ed->anum] ? str_get(ed->st[ed->anum]) : "");
  2747.         break;
  2748.         }
  2749.     }
  2750.     }
  2751. #endif
  2752.     return ed->sp;
  2753.  
  2754. say_yes:
  2755.     ed->str = &str_yes;
  2756.     goto normal_return;
  2757.  
  2758. say_no:
  2759.     ed->str = &str_no;
  2760.     goto normal_return;
  2761.  
  2762. say_undef:
  2763.     ed->str = &str_undef;
  2764.     goto normal_return;
  2765.  
  2766. say_zero:
  2767.     ed->value = 0.0;
  2768.     /* FALL THROUGH */
  2769.  
  2770. donumset:
  2771.     str_numset(ed->str,ed->value);
  2772.     STABSET(ed->str);
  2773.     ed->st[1] = ed->str;
  2774. #ifdef DEBUGGING
  2775.     if (debug) {
  2776.     dlevel--;
  2777.     if (debug & 8)
  2778.         deb("%s RETURNS \"%f\"\n",opname[ed->optype],ed->value);
  2779.     }
  2780. #endif
  2781.     return ed->arglast[0] + 1;
  2782. }
  2783.  
  2784. void init_eval()
  2785. {
  2786.     debarg = NULL;
  2787.     memset(&str_args, 0, sizeof(STR));
  2788.     old_rschar = 0;
  2789.     old_rslen = 0;
  2790. }
  2791.